作業を効率化させるExcel VBA Tips集資料作成中、頻繁にシートをまたぐ回数が多くなってきた場合に良いかも・・・

作業を楽にする為の苦労を惜しまない、本末転倒なプログラマーが実際に業務で使ったExcel VBAのサンプルを公開しています。掲載しているサンプルは関数単位ですので、部品化しやすいと思います。

資料作成中、頻繁にシートをまたぐ回数が多くなってきた場合に良いかも・・・

Excelで設計書やテスト仕様書などを作成していて、シート数が多くなってくると、
前のシートで何て書いたっけ？？と、Ctrl + PageUpまたはPageDownを連打して他のシートを参照し、そのわずらわしさにイラっとしたことはありませんか？
そして、ちょっとでもそのイライラを改善する為に、リネームコピーして２つExcelファイルを画面に表示させ、見ながら編集ってしたことありませんか？

そして、次第に集中力が切れてくると・・・どっちが編集中のファイルだったっけ？？
と混乱の原因にもなります。

上記改善策の流れを整理すると以下のようになります。

１．作業中のブックを上書き保存
　↓
２．マイコンピュータより、１のファイルをコピーする
　↓
３．２のファイルを参照用として開く

で、”どっちが編集中だったか？”とファイルを見分けるよりも、誤動作を防ぐため参照用シートは読み取り専用であれば、上書き保存をしようとした時に、気づくことができます。

これらを自動化させるには、以前紹介したVBAを組み合わせれることで可能です。

・作業を効率化させるExcel VBA Tips集ファイルを読み取り専用に設定する
・作業を効率化させるExcel VBA Tips集 VBAから作業中のブックをバックアップする

以下に組み合わせた場合のVBAを掲載します。

VBAの処理概要は以下の通りです。
①作業中のブックを上書き保存
②日付時刻を付加したファイル名文字列を作成する
③作業中ブックを②のファイル名でコピーする
④③のファイルを読み取り専用にする
⑤④のファイルを開く

'--------------------------------------------------------------------
' 関数名 : MkReadOnlyBook
' 機能   : 作業中ブックを読み取り専用でリネームコピーし、表示させる
' 引数   : なし
' 戻り値 : なし
' 作成日 : 2008/03/29
' 作成者 : lily(http://vbatips.blog37.fc2.com/)
'--------------------------------------------------------------------
Sub MkReadOnlyBook()
Dim wb As Workbook
Dim ret As Integer
Dim sFileName As String
Dim sNowTime As String

    '確認メッセージ
    ret = MsgBox("参照用ブックを作成しますか？", vbYesNo)
    If ret = vbNo Then
        Exit Sub
    End If
    
    'アクティブブック取得
    Set wb = ActiveWorkbook

    'アクティブブックの編集確認
    If wb.Saved = False Then
        '編集有りの場合は上書き保存を行う
        wb.Save
    End If

    '現在時刻を取得する
    sNowTime = CStr(Format(Date, "yymmdd")) & CStr(Format(Time, "hhmmss"))

    'コピー先のファイル名作成（フルパス）
    sFileName = wb.Path & "\" & sNowTime & "_" & wb.Name

    'コピー作成
    wb.SaveCopyAs sFileName
    
    '読み取り専用に設定
    Call SetReadOnly(sFileName)

    '読み取り専用のブックを開く
    Workbooks.Open fileName:=sFileName

End Sub
'--------------------------------------------------------------------
' 関数名 : SetReadOnly
' 機能   : ファイルを読み取り専用に設定する
' 引数   : フルパス
' 戻り値 : なし
' 作成日 : 2008/03/29
' 作成者 : lily(http://vbatips.blog37.fc2.com/)
'--------------------------------------------------------------------
Sub SetReadOnly(sPath As String)
Dim fso As FileSystemObject

    'ファイルシステムオブジェクト生成
    Set fso = New FileSystemObject
    
    '読み取り専用の設定
    fso.GetFile(sPath).Attributes = ReadOnly

    Set fso = Nothing
End Sub