''' <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
コメント