PR

【VBA】オブジェクトの情報を読み指定Sheet以外を削除する!

これで楽に!?VBA活用
記事内に広告が含まれています。

こんにちは、Ryoです。
Excelで原紙の役割を持つファイルはSheet数がかなり増えてしまい、実際使うときにSheetを探したり使わないものを削除したりと煩わしいことがあるんじゃないかと思います。
そこで今回は予めボタンをSheet分用意して、使うSheetのボタンを押すことで不要なSheetを削除しBookの名前を付けて保存するサンプルコードを紹介します。

処理する内容自体はそれほど大したことは無いのですが、ボタン等のオブジェクトからCaption(ボタンに付けた名前)を読み込み、処理に繋げるのは何かと有用なので知ってて損は無いかなと思います。

スポンサーリンク

1.サンプルファイル

Sample_A~EまでのSheetがあり、それらをボタンで用意します。
Sheetも準備しますがSample_AとSample_A(2)があるのは、原紙として使う際に同様式で複数ある方が都合が良い場合(例えば1枚に入力するデータに限度があり、複数枚にする等)もあるかと思いますので、例として入れています。

今回のサンプルではSample_Aを押すと、除外SheetとSample_AとA(2)を除いて全て削除し
Bookの名前を「Sample実行後+日付」で保存します。
こうすることで元の原紙ファイルが上書きされないようにします。
(消しちゃってから上書きすると大変なことになるので、念の為別の場所にコピー
しておく等のバックアップしてから試行するのが良いです)

2.サンプルコード

Sub フォーム選択_ボタン1_Click()

Dim wSht As Worksheet
Dim SheetCnt As Long
Dim Tilte, ExSht1, ExSht2 As String


Title = ActiveSheet.DrawingObjects(Application.Caller).Caption
'//押したボタンや図形等のオブジェクトからCaption情報を読み込む

ExSht1 = "除外SheetA"
ExSht2 = "除外SheetB"
'//除外(Exclusion)のシート名を指定しておく


For Each wSht In Worksheets
   
   If wSht.Name <> ExSht1 And wSht.Name <> ExSht2 Then
       If InStr(wSht.Name, Title) <> 1 Then
             Application.DisplayAlerts = False
             Worksheets(wSht.Name).Delete
             Application.DisplayAlerts = True
        End If
    End If
Next

Dim wkBook As Workbook

 Set wkBook = ThisWorkbook
 wkBook.SaveAs ThisWorkbook.Path & "\" _
 & "Sample実行後" & Format(Date, "YYYYMMDD")
             
End Sub

先ずCaption情報の取得ですが、
Title = ActiveSheet.DrawingObjects(Application.Caller).Caption
この記述部分にあるApplication.Callerを使います。

除外するSheetはそれぞれ変数に割り当てて、その後For Eachを使ってWorkSheet情報を
取得し、除外Sheet以外で且つCaption情報がSheet名に含まれないSheetを抽出して
Worksheets(wSht.Name).Deleteで削除します。

当然ながらコード実行後はUndoは使えませんから、ご注意くださいませ。

その後は現在のWorkBookの名前を変更して保存します。
wkBook.SaveAs ThisWorkbook.Path & “\” & _
“Sample実行後” & Format(Date, “YYYYMMDD”)

このサンプルでは元のファイルと同じ場所に保存する形としてwkBook.SaveAs ThisWorkbook.Pathとし、ファイル名は”Sample実行後+日付となります。

3.実行後

Sheetについてはこの通り除外分とSheetA、A(2) を残して削除されています。

ファイル名についても変更されて保存されていますので、元のファイルは無傷です。

別名で保存されたファイルはそのまま作業用ファイルとして使えると思いますから、
ちょっとしたことではあるものの、何かと便利です。



以上が簡単ですが、ボタン等のオブジェクトからCaption(ボタンに付けた名前)を
読み込み、不要なSheetを削除しBookの名前を付けて保存するサンプルコードでした。
後はSheetのコピーや移動等についても別の機会に書いてみようと思いますので、
よろしくお願いします。

 

Ryo

タイトルとURLをコピーしました