お知らせ

【VBA】便利マクロ

''' <summary>
''' シート整形
''' 表示倍率を100%に統一し、A1セルを選択する
''' </summary>
''' <remarks>
''' ファイル更新日時を変更しない
''' </remarks>
Sub GotoA1()
    ' 変数宣言
    Dim FSO As Object
    Dim Shell As Object
    Dim Wb As Workbook
    Dim Sh As Worksheet
    Dim FileName As String
    Dim f As Object
    Dim fl As Object
    Dim d As Date
    ' ファイル選択ダイアログ
    FileName = Application.GetOpenFilename("Excelブック,*.xls*")
    If FileName = "False" Then
        ' キャンセル
        Exit Sub
    End If
    ' ファイル更新日時を記録する
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set f = FSO.GetFile(FileName)
    d = f.DateLastModified
    ' 各シート反復処理
    Set Wb = Workbooks.Open(FileName)
    For Each Sh In Wb.Worksheets
        Call Sh.Activate
        ' 表示倍率100%
        ActiveWindow.Zoom = 100
        ' A1セル選択
        Call Application.Goto(Sh.Range("A1"), True)
    Next Sh
    ' 先頭シート選択
    Call Wb.Worksheets(1).Activate
    ' ファイル保存
    Call Wb.Save
    ' ファイル更新日時を元に戻す
    Set Shell = CreateObject("Shell.Application")
    Set fl = Shell.Namespace(FSO.GetParentFolderName(FileName))
    Set f = fl.ParseName(FSO.GetFileName(FileName))
    f.ModifyDate = d
End Sub



コメント