投稿

  Sub ShowImage(imagePath As String, targetSheet As Worksheet) Dim img As Object ' 画像を表示 Set img = targetSheet.Shapes.AddPicture(Filename:=imagePath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _ Left:=targetSheet.Range("A1").Left, Top:=targetSheet.Range("A1").Top, Width:=-1, Height:=-1) ' 画像を指定範囲に拡大表示 With img .LockAspectRatio = msoTrue ' 縦横比を維持 .Width = targetSheet.Range("R20").Left - targetSheet.Range("A1").Left .Height = targetSheet.Range("R20").Top - targetSheet.Range("A1").Top .Placement = 1 ' xlMoveAndSize End With End Sub
 
 モード選択 以下のVBAコードは、ボタンを押すとメッセージボックスが表示され、ユーザーが「画像1」または「画像2」を選択できるようにします。選択に応じて、あらかじめ設定されているマクロAまたはマクロBが実行されます。 Sub ShowImageSelector()     Dim selectedImage As String          ' モード選択メッセージボックスを表示     selectedImage = MsgBox("画像を選択してください。", vbQuestion + vbYesNoCancel, "画像選択")          ' 選択された画像に応じて処理を実行     Select Case selectedImage         Case vbYes ' 画像1が選択された場合             Call Image1_Click ' 画像1のクリック処理を実行         Case vbNo ' 画像2が選択された場合             Call Image2_Click ' 画像2のクリック処理を実行         Case vbCancel ' キャンセルが選択された場合             ' 何もしない     End Select End Sub Sub Image1_Click()     ' 画像1がクリックされたときの処理を記述     ' 例えば、dataシートのA10にある画像1をクリックした場合の処理を記述     MsgBox "画像1がクリックされました。"     Call MacroA ' マクロAを実行 End Sub Sub Image2_Click()     ' 画像2がクリックされたときの処理を記述     ' 例えば、dataシートのZ10にある画像2をクリックした場合の処理を記述     MsgBox "画像2がクリックされました。"     Call MacroB ' マクロBを実行 End Sub Sub MacroA()     ' 画像1の処理を記述  
イメージ
 
 時間外モード 以下のコードは、まずDataシートのセルA1にある画像をSheet1のセルA1からR20の範囲に拡大して表示し、0.1秒後に削除し、その後DataシートのセルZ1にある画像を同様に表示して、0.1秒後に削除します。 Sub ShowAndHideImage()     Dim img As Object     Dim dataSheet As Worksheet     Dim targetSheet As Worksheet     Dim imagePath As String          ' ワークシートを設定     Set dataSheet = ThisWorkbook.Sheets("Data") ' 画像があるシート     Set targetSheet = ThisWorkbook.Sheets("Sheet1") ' 画像を表示するシート          ' 画像ファイルのパスを取得して画像を表示     ShowImage dataSheet.Range("A1").Value, targetSheet          ' 0.1秒後に画像を削除     Application.OnTime Now + TimeValue("00:00:00.1"), "HideImage", , True          ' 0.1秒待ってから次の画像を表示     Application.Wait Now + TimeValue("00:00:00.1")          ' 画像ファイルのパスを取得して画像を表示     ShowImage dataSheet.Range("Z1").Value, targetSheet          ' 0.1秒後に画像を削除     Application.OnTime Now + TimeValue("00:00:00.1"), "HideImage", , True End Sub Sub ShowImage(imagePath As
 Sub UpdateValue()     Dim ws1 As Worksheet     Dim ws2 As Worksheet     Dim valueToWrite As Variant     Dim valueToWrite1 As Variant     Dim sourceRange As Range     Dim targetRange As Range          ' sheet1とsheet2を指定     Set ws1 = ThisWorkbook.Sheets("Sheet1")     Set ws2 = ThisWorkbook.Sheets("Sheet2")          ' Sheet2のO53の値を取得     valueToWrite = ws2.Range("O53").Value          ' O53の値がある場合、Sheet1のQ15の値をO107の値に上書き     If Not IsEmpty(valueToWrite) Then         ws1.Range("Q15").Value = ws2.Range("O107").Value         Exit Sub     End If     ' Sheet1のQ15の値を取得     valueToWrite1 = ws1.Range("Q15").Value          ' Q15の値がO107からO111の範囲に含まれているか確認     If valueToWrite = ws2.Range("O107").Value Then         ws1.Range("Q15").Value = ws2.Range("O108").Value     ElseIf valueToWrite = ws2.Range("O108").Value Then         ws1.Range("Q15").Value = ws2.Range("O109&q
 Sub SearchAndUpdate()     Dim searchRange As Range     Dim searchValue As Variant     Dim cell As Range          ' 検索範囲を指定(C15からO15の範囲)     Set searchRange = Range("C15:O15")          ' 検索する値を取得     searchValue = Range("C17").Value          ' 検索範囲をループして値を比較し、一致するセルがあれば更新する     For Each cell In searchRange         If cell.Value = searchValue Then             Range("Q15").Value = searchValue             Exit For ' 一致するセルが見つかったらループを終了         End If     Next cell End Sub