VBA｜コードが長いプロシージャを短く切り分ける｜マクロを部品化する

コードが長いプロシージャを短く切り分けました

こうなるとシンプルに「読みにくい」ですよね。

関連書籍

プロシージャを分割するとは（サブルーチンとは）

サブルーチンの使い方【マトリクスで理解する】プロシージャを分割したマクロを用意する方法

マクロを部品化する

あなたの作るマクロが100ステップを超えてくるようになると、1つのマクロで全ての処理を行うことにはっきりと無理が出てくるでしょう。

このようなときには、処理単位でマクロを作り、親マクロからそれらの部品マクロ（サブルーチン）を呼び出すようにした方がはるかに効率的でスマートです。

Excel VBAで本当に大切なアイデアとテクニックだけ集めました。 大村あつし:著

以降でマクロを部品化していきます。

改善前

具体例を使って実際に長いプロシージャを見易くしていきましょう。まずは改善前のプロシージャを紹介します。

元になるプロシージャはこちら

階層構造のフォルダ群から任意の画像を取得VBAで画像を取り込む高速で画像自体を取得しエクセルに貼り付ける

改善後

作業環境（ワークフロー）

最初にワークフローを紹介します。

よって最終的には10枚の同じ画像がserch_picture.xlsmに持ち込まれることになります。

この建物は外観にインパクトがあるのですが中はさらに良い空間です。光の入り方が素晴らしいです。

ワークシート

serch_picture.xlsm内の画像です。最終的に赤枠のセルの中に画像が格納されることになります。

操作方法

大きく分けて3工程です。1つ上で紹介した画像と合わせてみていただき操作方法を理解してください。

セルI2付近にある削除ボタンは取得した画像を一気に削除する事ができるボタンです。

実行後

赤枠の様にセルに画像が入ります。今回は10枚同じ画像が格納されますのでセルA14まで画像が入る事になります。

作業環境やワークシート、操作方法について説明しました。次はコードを紹介していきます。

プロシージャ、コードの紹介

コードを紹介する前に各プロシージャを紹介します。プロシージャは3つです。

Sub main()

Dim base_path As String 'ファイルパスを格納 セルA3に\を足す
Dim file_name As String '画像名
Dim file_path As String  '上2つの変数をセットにして格納
Dim idx As Long: idx = 2 ' 貼付け位置を管理する変数
Dim fso As Object ' ファイルシステムオブジェクト
Dim s_fd As Object  '現状掴んでるフォルダを格納する変数
Dim rng As Range '貼り付けるセルを格納

Application.ScreenUpdating = False
'オブジェクト変数にファイルシステムオブジェクトをセット

Set fso = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッドでフォルダを選択

For Each s_fd In fso.GetFolder(Cells(3, 1)).subfolders

    Call make_Path(s_fd, base_path, file_name, file_path) 'サブルーチンで画像を選択
    
    Do Until file_name = ""
        
        If file_name Like "*-1*" Then '画像名に -1 が含まれているかを確認
            Set rng = Cells(idx + 3, 1) '条件Trueなら貼り付けるセルを決める
            Call get_Picture(rng, idx, file_path) 'サブルーチンで画像を取得＆大きさ調整
        End If
        
        file_name = Dir() 'ポイント：サブルーチンで実行したDir関数の値を引き継いでいる
        file_path = base_path & file_name '次の画像を選択 無ければループを抜ける事になる
        
    Loop
    
Next s_fd '次のフォルダを取りにいく

Application.ScreenUpdating = True

MsgBox "処理が完了しました", , "作業完了"

End Sub
'****************************************************************************************************
Sub make_Path(ByVal fd As Object, ByRef bp As String, ByRef fn As String, ByRef fp As String)

bp = fd & "\" 'パスとファイル名を繋ぐための\を含めて変数にとる
fn = Dir(bp, vbNormal) '画像ファイルを選択
fp = bp & fn 'パスと画像ファイルの文字列を一緒にしてフルパスを生成する

End Sub
'****************************************************************************************************
Sub get_Picture(ByVal rg As Range, ByRef i As Long, ByVal fp As String)

'指定されたセルに画像を用意する（詳細は元記事に任せます）
With rg.Worksheet.Shapes.AddPicture(Filename:=fp, _
                                  LinkToFile:=False, _
                                  SaveWithDocument:=True, _
                                  Left:=rg.Left, _
                                  Top:=rg.Top, _
                                  Width:=0, _
                                  Height:=0)
                         
    .LockAspectRatio = True
    .Placement = xlMoveAndSize
    
    .ScaleHeight 1, msoTrue
    .ScaleWidth 1, msoTrue
    
    'ここから画像をセルに合わせ込む作業（詳細は元記事に任せます）
    If .Width > rg.Width - 2 Then
      .Width = rg.Width - 2
    End If
    
    If .Height > rg.Height - 2 Then
      .Height = rg.Height - 2
    End If
    
    .Top = .Top + ((rg.Height - .Height) / 2)
    .Left = .Left + ((rg.Width - .Width) / 2)
         
 End With

 i = i + 1

End Sub

コードの解説

1_mainプロシージャ

Do While ～ LoopステートメントなどVBA｜Dir関数を使ってフォルダ内の複数ファイルを順番に処理する

For Each ～ Nextステートメントマクロで特定文字を含むシートを選択｜For Each ～ Next & Like

2_make_Pathプロシージャ

3_get_Pictureプロシージャ

引数を理解するAddPictureメソッドエラー対策|指定された値は境界を超えています

その他：ScreenUpdatingプロパティ

ScreenUpdatingプロパティとは

まとめ

EnjoyExcel