2015-12-26

Excel VBA のメモ

Excel VBA

ブックを開いたときにい全てのシートに同じ余白を設定する

全てのドキュメントで常に同じ余白を自動設定したいときに。ファイルをいちいちマクロ付きで保存しなきゃいけないなどの面倒くささは残る。

また、BlackAndWhite（Boolean）を設定すれば白黒印刷も自動化できるので、経費削減などで白黒印刷を推奨している現場では役に立つ（かもしれない）。

Private Const MARGIN_OUTER As Single = 1.5
Private Const MARGIN_INNER As Single = 3

Private Sub Workbook_Open()
    With ThisWorkbook
    For i = 1 To Worksheets.Count
        With .Worksheets(i).PageSetup
            .HeaderMargin  = Application.CentimetersToPoints(MARGIN_OUTER)
            .FooterMargin  = Application.CentimetersToPoints(MARGIN_OUTER)
            .TopMargin     = Application.CentimetersToPoints(MARGIN_INNER)
            .RightMargin   = Application.CentimetersToPoints(MARGIN_INNER)
            .BottomMargin  = Application.CentimetersToPoints(MARGIN_INNER)
            .LeftMargin    = Application.CentimetersToPoints(MARGIN_INNER)
            .BlackAndWhite = True '白黒印刷
        End With
    Next
End Sub

PageSetup オブジェクト (Excel)

ファイル選択ダイアログを表示する

Private Const INPUTFILE_COUNT As Byte = 2

Sub main()
    Dim i As Long
    Dim inputfile(INPUTFILE_COUNT - 1) As Variant
    For i = 0 To UBound(inputfile)
        inputfile(i) = Application.GetOpenFilename(, , i + 1 & "つ目のファイルを選択してください")
        If inputfile(i) = False Then Exit Sub
    Next
End Sub

Application.GetOpenFilename メソッド (Excel)

ブックを開いた時に自動実行する関数と閉じるときに自動実行する関数

Sub Workbook_Open()
Sub Workbook_Close()

新しいブックを作成してデータを書き込む

マクロを実行するためのファイルと CSV ファイルなどのファイルをインポートしたデータを同じファイルに保存してしまうとファイルサイズが増えてしまうので結果を新しいブックに書き込む。

Private new_wb_ws1 As Worksheet
Private new_wb_ws2 As Worksheet

Private Function CreateNewWorkbook()
    Dim tmp As Long
    Dim new_wb As Workbook
    tmp = Application.SheetsInNewWorkbook '新しいブックのシート数設定を保存
    Application.SheetsInNewWorkbook = 2
    Set new_wb = Workbooks.Add
    With new_wb
        Set new_wb_ws1 = .Worksheets(1)
        Set new_wb_ws2 = .Worksheets(2)
    End With
    Application.SheetsInNewWorkbook = tmp
End Function

Sub main()
    Call CreateNewWorkbook
    new_wb_ws1.Cells(1).Value = 1
    new_wb_ws2.Cells(1).Value = 2
End Sub