範囲を指定する場合としない場合どちらでも動くようにしたいです

投稿者 : めめ     投稿日時 : 2024/09/03(Tue) 16:34:49     OS : Windows 10     EXCEL : 未指定

---

Sub SmartImageInjector()
    Dim folderPath As String
    Dim filesInFolder As Object
    Dim file As Object
    Dim rowIndex As Long
    Dim columnIndex As Long
    Dim sheet As Worksheet
    Dim imgComment As Comment
    Dim index As Long
    Dim excludedRange As Range
    Dim configSheet As Worksheet
    Dim targetSheetName As String
    Dim imgHeight As Single
    Dim imgWidth As Single
    Dim rangeAddress As String
    Dim rowOffset As Long
    Dim rangeColumns As Long
    Dim currentRange As Range
    Dim cell As Range
    Dim firstRange As Boolean

    ' 設定用のシートを指定
    Set configSheet = ThisWorkbook.Sheets("Config") ' 設定シート名を"Config"と仮定
    
    ' 設定シートから値を取得
    folderPath = configSheet.Range("A1").Value ' フォルダパスをA1セルから取得
    targetSheetName = configSheet.Range("A2").Value ' 対象のシート名をA2セルから取得
    imgHeight = configSheet.Range("A3").Value ' 画像の高さをA3セルから取得
    imgWidth = configSheet.Range("A4").Value ' 画像の幅をA4セルから取得
    
    ' 範囲アドレスと行のオフセットを設定シートから取得
    rangeAddress = configSheet.Range("A5").Value ' 範囲アドレス（例: "A1:F1"）をA5セルから取得
    rowOffset = configSheet.Range("A6").Value ' 行オフセット（例: 5）をA6セルから取得
    
    ' 対象のシートを指定
    Set sheet = ThisWorkbook.Sheets(targetSheetName)
    
    ' フォルダ内のファイルを取得
    Set filesInFolder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files
    
    ' 除外するセル範囲を設定（A10以降のセルから範囲を取得）
    firstRange = True
    For Each cell In configSheet.Range("A10:A" & configSheet.Cells(configSheet.Rows.Count, "A").End(xlUp).Row)
        If firstRange Then
            Set excludedRange = sheet.Range(cell.Value)
            firstRange = False
        Else
            Set excludedRange = Union(excludedRange, sheet.Range(cell.Value))
        End If
    Next cell

    ' 範囲の列数を取得
    rangeColumns = sheet.Range(rangeAddress).Columns.Count

    ' インデックス変数と初期値の設定
    index = 0
    
    ' ファイルを順番に処理
    For Each file In filesInFolder
        ' 画像ファイルかどうかをチェック (jpgとpngだけ)
        If LCase(Right(file.Name, 4)) = ".jpg" Or LCase(Right(file.Name, 4)) = ".png" Then
  
            ' インデックスの計算
            Do
                rowIndex = (index \ rangeColumns) + rowOffset
                columnIndex = (index Mod rangeColumns) + 1
                index = index + 1
            Loop While Not Intersect(excludedRange, sheet.Cells(rowIndex, columnIndex)) Is Nothing

            ' セルに画像を挿入
            Set imgComment = sheet.Cells(rowIndex, columnIndex).AddComment
            With imgComment.Shape
                .Fill.UserPicture file.Path
                .Height = imgHeight ' 設定シートから取得した値を使用
                .Width = imgWidth   ' 設定シートから取得した値を使用
            End With
            imgComment.Visible = True
        End If
    Next file

    ' メモを非表示にする設定
    For Each imgComment In sheet.Comments
        imgComment.Visible = False
    Next imgComment
    
    ' 完了メッセージを表示
    MsgBox "画像の挿入が完了しました。"
End Sub

Excelのコメント欄に画像を貼り付けたいです。
上記のコードの除外範囲の設定で除外範囲を設定する場合と設定しない場合（A10以下は空白にしたい）のどちらの場合でも動くようにしたいのですがどのように変更したらよいでしょうか？？

上記のコードのままだと除外範囲を設定していないとエラーになり困っています。
VBA初心者でほぼchatGPTにやってもらったのでどうしたらよいかわかりません。
肝心のchatGPTはエラーになるコードばかりで困りました。

よろしくお願いします。

投稿者 : めめ     投稿日時 : 2024/09/03(Tue) 16:51:42

---

解決しました