2011 年 10 月以降に公開された Excel 2007 の更新プログラムを適用すると表示通りに印刷できない

2011 年 10 月以降に公開された Excel 2007 の更新プログラムを適用すると表示通りに印刷できない



な、なんだってーーー！！！（AA略



今晩は。無隊長です。

表題の件、今年3月のMSサポートなのですが、これは困った。

なんでって医療関係者の方々から大絶賛されているMNA®スターターキットExcel版に影響するじゃないか。



今のところ当事象に関する修正パッチはまだリリースされておらず、
回避方法は該当のアップデートを削除する、との事です。

Hotfixは出てまして、弊社Excel2007環境では正常動作を確認しておりますが、
一般ユーザー様へはあまりお勧めできません。
（ちゃんとテストされてないから解決するかどうかわからないし余計ぶっ壊れるかもよと脅し文句が書いてあるものなので）

MSからの修正パッチを待ちましょう・・・

[Excel]シートを別ブックに保存する

こんちは。部隊長です。
梅雨でジメジメの蒸し暑暑ですが元気に行きましょう。寒いより暑いほうが好きです。女子は薄着になるし。

今回もまたExcelVBAで芸がないのですが、30分考えたので書き起こします。

そもそもあるシートを新規ブックとして起動させるには、

Dim sht as WorkSheet
Set sht = ThisWorkbook.Worksheets("対象のシート")
sht.Copy

これだけ。
対象シートが非表示の場合、Copyメソッドが失敗しますので、
ブックの保護解除とシートの可視化も導入

Dim sht as WorkSheet
Set sht = ThisWorkbook.Worksheets("対象のシート")
ThisWorkbook.Unprotect Password:=BKPWD
sht.Visible = True
sht.Copy
sht.Visible = False
ThisWorkbook.Protect Password:=BKPWD

この新規ブックを別名で保存するには、CopyするとWorkBooksがAddされたのと同じ状態になりますので、

'' 最後のブックを別名で保存
Workbooks(Workbooks.Count).SaveAs newFileNm, FileFormat:=xlNormal

します。ActiveWorkBookでもいいですが、Copyの後にActiveが動くような事があると・・・

というわけで全体のコードはこんな感じ。CSV形式での保存も対応しています。

Sub SaveAsOtherName

 Dim newName As String
 newName = _
     Application.GetSaveAsFilename( _
          InitialFileName:="デフォのファイル名" _
        , FileFilter:="エクセルファイル(*.xls),*.xls" & _
         ",CSVファイル(*.csv),*.csv" _
        , FilterIndex:=1 _
        , Title:="保存先の指定" _
        )

 If newName = "FALSE" Then Exit Sub
 If Dir(newName) <> "" Then
     If MsgBox("同名のファイルが存在します。上書きしてもよろしいですか？", Title:=MSGBOX_TITLE, Buttons:=vbYesNo) <> vbYes Then
         Exit Sub
     End If
 End If

 Dim sht As Worksheet: Set sht = ThisWorkbook.Worksheets("コピー対象シート名")

 ThisWorkbook.Unprotect Password:=BKPWD
 sht.Visible = True
 sht.Copy
 sht.Visible = False
 ThisWorkbook.Protect Password:=BKPWD

 Application.DisplayAlerts = False

 '' 新ファイル名称の拡張子で保存形式を判定しています。
 If CheckExtension("xls", newName) Then
     Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlNormal
 Else
     Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlCSV
 End If

 ActiveWorkbook.Close

 Application.DisplayAlerts = True

 MsgBox "保存しました", Title:=MSGBOX_TITLE
 
End Sub

divirta-se!

[ExcelVBA] AdvancedFilterでGroupBy

こんにちは。部隊長です。
おなじみExcelVBAのAdvancedFilterを使って、ExcelのデータをDBのようにGROUP BYしてしまおうというネタです。

メニューから行くとフィルタオプションというのがありますが

これを使います。

一番最初にやるのは、GROUPしたい項目を抜き出すことです。

抽出元のシートから、ヘッダーにする項目をコピーし、抽出先のシートに貼っておきます。

同時に、データの抽出先としても貼りつけておきましょう。

この時に、抽出条件の下に条件を書けば任意のデータを抽出する事ができます。

ここでは鈴木さんの年齢をGROUPしてみます（どんだけ鈴木さんいんだよって話ですが）

抽出条件に="鈴木"と書いているのは、単に「鈴木」と書いた場合部分一致になってしまうからです。

また、部分一致の挙動が2002と2003以降等Excelのバージョンで異なるため、

誤動作を防ぐためには="○○"と書くとよいです。

先頭に=を書くと数式扱いになってしまいますので、セルの書式を文字列にするか、

先頭に「'」を打って文字列にしましょう。

それでは先程のフィルタオプションメニューを開き、

まずは抽出先に「選択した範囲」として、データ元にしたいセル範囲を指定しましょう。

次に先ほど用意した抽出先と出力先をそれぞれ

「検索条件範囲」と「抽出範囲」に指定します。

※抽出条件は、指定するしないに関わらずタイトル行入れて最低2行指定！

設定画面に戻ったら、「重複するレコードは無視する」にチェックを入れます。

じつはコレでGroupできるのです。

準備が終わったらOKを押してみましょう。

うまく抽出されましたか？

で、タイトルにVBAって書いたのに長々と操作の説明になってしまいましたが、

コードはこんな感じです。

データシートのフィルタモード解除、出力先のクリアを追加しています。

GROUPしたい場合、unqにTRUEを指定して下さい。

''' TEST
Private Sub test()

    Dim sh As Worksheet
    Dim db As Range, crt As Range, ext As Range
    
　　'' 結果のシート
    Set sh = ThisWorkbook.Worksheets("抽出結果シート")
　　'' データ範囲指定
    Set db = ThisWorkbook.Worksheets("データ").Range("A:X")
　　'' 抽出条件（タイトル含め条件の行数全部）
    Set crt = sh.Range("A2:B3")
　　'' 抽出先（タイトル行のみ指定）
    Set ext = sh.Range("D2:E3")
    
    If doAdvancedFilter(db, crt, ext, True) Then
       '’成功
    End If
    
End Sub

''' AdvancedFilter実行
''' データレンジのシートがフィルタされてたら解除する
''' 抽出レンジのデータは末尾までクリアする
''' 検索レンジが1行の場合エラー
''' 検索レンジは2行以上指定すること
Public Function doAdvancedFilter(ByVal dbRange As Range, _
                            ByVal crtRange As Range, _
                            ByVal extRange As Range, _
                            ByVal unq As Boolean) As Boolean

On Error GoTo Err:
    
    Dim sht As Worksheet
    
    If crtRange.Rows.Count <= 1 Then
        MsgBox "抽出条件が不正です"
        Exit Function
    End If
    
    Set sht = dbRange.Parent
    If sht.FilterMode Then sht.ShowAllData
   
    '' 最大行数
    Dim mxR As Long
    Set sht = crtRange.Parent
    mxR = sht.Rows.Count
    
    '' extRangeクリア
    Dim fCell As Range
    Set fCell = extRange.Range("A1")
    fCell.Offset(1, 0).Resize(fCell.Offset(1, 0).End(xlDown).Row - fCell.Row, extRange.Columns.Count).Clear
   
    '' Filter実行
    dbRange.AdvancedFilter xlFilterCopy, crtRange, extRange, unq
    
    doAdvancedFilter = True
    Exit Function
    
Err:
    MsgBox Err.Description

End Function

抽出条件を色々工夫して大変なデータ処理を楽に済ませちゃいましょう！

[Excel]VBAコードのバージョン管理

こんばんは。部隊長です。
今回も引き続きExcelVBAのネタです。

Excelでの開発は、Excelファイル本体がバイナリであるため
バージョン管理を行う事が困難です。
（2007以降はzip解凍してxml形式になるようですが・・・）

また、VBAのモジュールは開発が進むにつれ、履歴がたまりファイルサイズが大きくなります。
モジュール自体が破損する事も多いようですね。
そういうときの対処として、モジュールを全てエクスポートし、インポートし直すと最適化される、
というのがネットに載っています。

それであれば、モジュール自体でソース管理してしまった方が良いでしょう。
モジュールはテキストファイルですので、バージョン管理ソフトとの親和性も高いです。

そこで、モジュールファイルを一括してエクスポート、
または全て解放後、一括してインポートするコードをご紹介します。

本体のファイル直下にForm、Class、Module、それぞれのフォルダを作成し、エクスポートするコードと、それらのフォルダからインポートするコードです。

一括エクスポートした後はVSSなりSVNなりにコミットしたって下さい。

''-----------------------------------------------------------------------
'' 全プロジェクトファイルエクスポート（ブック・シートに付随するコード以外）
'' 事前にマクロのセキュリティ→VBAのオブジェクトモデルへのアクセスを許可する事（実行時エラーになります。）
''-----------------------------------------------------------------------
Private Sub Export_All()

    Dim Path As String
    Dim i As Integer
    
    Const cls As String = "\Class\"
    Const FRM As String = "\Form\"
    Const MODL As String = "\Module\"
    
    Const EXT_MODL As String = ".bas"
    Const EXT_CLS As String = ".cls"
    Const EXT_FRM As String = ".frm"
    
    Path = ThisWorkbook.Path
    
    '' エクスポートフォルダ
    If Dir(Path & cls) = "" Then MkDir (Path & cls)
    If Dir(Path & FRM) = "" Then MkDir (Path & FRM)
    If Dir(Path & MODL) = "" Then MkDir (Path & MODL)
    
    With ActiveWorkbook.VBProject
    
        For i = 1 To .VBComponents.Count
        
            Select Case .VBComponents(i).Type
            Case 1  '' vbCompTypeModul
                .VBComponents(i).Export Path & MODL & .VBComponents(i).Name & EXT_MODL
            Case 2 '' vbCompTypeClassModul
                .VBComponents(i).Export Path & cls & .VBComponents(i).Name & EXT_CLS
            Case 3 '' vbCompTypeUserform
                .VBComponents(i).Export Path & FRM & .VBComponents(i).Name & EXT_FRM
            End Select
        Next
    
    End With
    
End Sub


''-----------------------------------------------
''--プロジェクトファイル洗い替え-----------------
''-----------------------------------------------
Private Sub Refresh()

    Call Release_All
    Call Import_All

End Sub


'' 全プロジェクトファイルリリース
Private Sub Release_All()

    Dim i As Integer
    Dim colComName As New Collection
    
    With ThisWorkbook.VBProject
   
        For i = 1 To .VBComponents.Count
            If .VBComponents(i).Type = 1 Or .VBComponents(i).Type = 2 Or .VBComponents(i).Type = 3 Then
                colComName.Add (.VBComponents(i).Name)
            End If
        Next
    
        For i = 1 To colComName.Count
            .VBComponents.Remove .VBComponents(colComName(i))
        Next
    
    End With
    
    Set colComName = Nothing
    

End Sub

'' 全プロジェクトファイルインポート
Private Sub Import_All()

    Dim Path As String
    Dim i As Integer
    
    Const cls As String = "\Class\"
    Const FRM As String = "\Form\"
    Const MODL As String = "\Module\"
    
    Const EXT_MODL As String = ".bas"
    Const EXT_CLS As String = ".cls"
    Const EXT_FRM As String = ".frm"
    
    Path = ThisWorkbook.Path
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fileList As Object
    
    '' Cls
    Set fileList = fso.GetFolder(Path & cls).Files
    For Each file In fileList
        ActiveWorkbook.VBProject.VBComponents.Import Path & cls & file.Name
    Next
    
    '' Form
    Set fileList = fso.GetFolder(Path & FRM).Files
    For Each file In fileList
        If Right(file.Name, 4) = EXT_FRM Then
            ActiveWorkbook.VBProject.VBComponents.Import Path & FRM & file.Name
        End If
    Next
    
    '' Module
    Set fileList = fso.GetFolder(Path & MODL).Files
    For Each file In fileList
        ActiveWorkbook.VBProject.VBComponents.Import Path & MODL & file.Name
    Next
    

End Sub

これをアドインにしてインストールして置くと便利。
但し、シートオブジェクトやブックオブジェクトに記述されているコードは対象外となるので、
そこらへんは手作業なのが玉に傷。



ネタ元はネットに散らばっていた情報ですので、ご利用は自己責任でお願いいたします・・・ 

[EXCEL]Chart.Export makes 0byte File

こんちは。Azureの続きをやるやる詐欺続行中の部隊長です。
今回もAzureはちょっとおいといて、絶賛進行中のプロジェクトから１ネタ。


現在進行中のプロジェクトで、某社販促グッズとして提供している某Excelブック（以下ツール）の改修を行っております。なんのこっちゃですね。

このツールでは集計したデータでグラフを作成し、それをフォームで表示するために一旦gifにExportしているんですね。

こんな感じで。

'' グラフタイトル設定
        .ChartObjects(1).Chart.ChartTitle.Text = GRAPHTITLE_ALL & " n=" & .Range(VALUE_N).Value        
        '' 画像ファイルのExport
        .ChartObjects(1).Chart.Export ThisWorkbook.Path & GRAPHPICT_ALL

このコードはExcel2000から2007まで問題なく動作します（97以前も動くかもしれんけど）
で、基本的に2010でも動くはず。

と思ったら、フォーム側のImageにロードする時にエラーが・・・

何故だと思ったら、出力されたファイルが0kbなんですね。空っぽです。
ググっても殆ど情報は出てきません・・・

そこで試しに簡単なサンプルを書いたら問題なく動作します。なんで？
・
・
・

対象のグラフが載ってるシートは非表示・・・！サンプルは表示・・・！

というわけでVisibleにしてやったらちゃんと動いた、というわけでした。

しかし、このブックはパスワードでロックされていて、表示するにはUnLockしなければならない・・・

というわけでこうゆう事になりました。

'' Visible Befor Export (for Excel2010)
     ThisWorkbook.UnProtect password:="XXXXXXXXX"
        .Visible = xlSheetVisible
        
        '' 画像ファイルのExport
        .ChartObjects(1).Chart.Export ThisWorkbook.Path & GRAPHPICT_ALL
        
        .Visible = xlSheetHidden
     ThisWorkbook.Protect password:="XXXXXXXXXX"
        '' --

これはちょっと行き当たりばったり過ぎだろJK・・・

つかこんなとこにパスワード書くなよ。書き直し。

教訓：非表示シートを弄る際はお気をつけ下さい。