という記事が先日話題になっていて、大変懐かしいなあと遠い目をしながら眺めておりました。
やりましたやりました。BeforeAfterでパシャリ。書き込みもして印刷範囲もバッチリに整えたところでバグが発覚し、スクショ撮り直し...
どうせ見ないんだしこんな大量に印刷する意味あるのかよ などと思いながら作業してたのを思い出します。
有事の際に自分を守ってくれるものなので、粛々と作業しましょう。というこの方の主張に賛成です。面倒ですけど。
この記事の感想Tweetに下記のようなものがありましたので、代わりにやってくれるツールを作りました。ご自由にお使いください。
"@daiksy: Excelのスクショ撮る仕事なんてまだまだ序の口ですよ。世の中には納品前日に全てのExcelドキュメントをOpenし、カレントカーソルをA列1行目に設置してから保存、を数時間かけてやる仕事もあるんですよ！"
「Alt + F11でVBAEditorを開く→挿入→標準モジュール→貼り付け」
---------
'処理概要：指定フォルダのexcelファイルを開き、A1セルをアクティブにして保存する
Sub Tediousjob()
Dim f As Object, cnt As Long
Dim FlolderPass As String
'画面の更新を停止
Application.ScreenUpdating = False
'対象フォルダの選択
FlolderPass = SelectFolder
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(FlolderPass).Files
If Left(f.Type, 15) = "Microsoft Excel" Then
'ファイルを開く
Workbooks.Open Filename:=FlolderPass & "\" & f.Name
'「A1CellActive」呼び出し
Call A1CellActive
'ファイルを閉じる
ActiveWorkbook.Close
End If
Next f
End With
'画面の更新を再開
Application.ScreenUpdating = True
End Sub
'処理概要：対象フォルダを選択する
Function SelectFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
SelectFolder = .SelectedItems(1)
End If
End With
End Function
'処理概要：各シートのA1セルをアクティブにし、保存して閉じる
Sub A1CellActive()
Dim i As Long
Dim mySheetCnt As Long
Dim mySheetName As String
Dim myFirstSheetName As String
mySheetCnt = ThisWorkbook.Sheets.Count
For i = 1 To mySheetCnt
mySheetName = Sheets(i).Name
If i = 1 Then
myFirstSheetName = mySheetName
End If
Sheets(mySheetName).Select
Range("A1").Select
Next i
'1sheet目をアクティブにする
Sheets(myFirstSheetName).Select
'save
ActiveWorkbook.Save
End Sub
