画像表示マクロ ができるまで その3
はじめに
前回、
vba-belle-equipe.hatenablog.com
表示される画像の大きさと位置を調節しました。
今回は、
- 行を選択した時に画像変更
できるようにして、マクロを完成させたいと思います。
おさらい
ここまでで、
Sub test() Dim imgPath As String Dim myShape As Shape Dim bairitu As Double imgPath = "C:¥test¥フリー画像素材¥ahiru.jpg" Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=imgPath, _ Linktofile:=True, _ SaveWithDocument:=False, _ Left:=0, _ Top:=Rows(1).Height, _ Width:=0, _ Height:=0) With myShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue bairitu = Columns(1).Width / .Width .ScaleHeight bairitu, msoTrue .ScaleWidth bairitu, msoTrue End With End Sub
「imgPath」に、画像のパスを入れて、A2セルの上辺にあわせて表示するところまでできています。
選択した行の画像パスを表示する
こんな感じでD列に画像ファイルのパスが入っていますので、
シートのSelectionChangeイベントで、パスを表示させてみます。
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Debug.Print Cells(Target.Row, 4) End Sub
こんな感じです。
イミディエイトウインドウに表示されました。
画像パスを渡して表示させるようにする
'////標準プロシージャ//// Sub 画像表示(imgPath As String) Dim myShape As Shape Dim bairitu As Double Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=imgPath, _ Linktofile:=True, _ SaveWithDocument:=False, _ Left:=0, _ Top:=Rows(1).Height, _ Width:=0, _ Height:=0) With myShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue bairitu = Columns(1).Width / .Width .ScaleHeight bairitu, msoTrue .ScaleWidth bairitu, msoTrue End With End Sub
'////ワークシートのイベントプロシージャ//// Private Sub Worksheet_SelectionChange(ByVal Target As Range) Call 画像表示(Cells(Target.Row, 4)) End Sub
imgPathを引数にして表示させるように変更します。
結果
上から順にセルを選択していくと、
画像が重なって表示されちゃっています。
そして、空白の行をクリックすると
実行時エラー'1004':指定したファイルが見つかりませんでした。
怒られます。(まあ、当然ですが)
あ、それとA1セルの見出しを変えないといけませんでしたね。
修正する
修正しましょう。
見出し変更
C列に見出しの情報があるので
Range("A1") = (Cells(Target.Row, 3))
をイベントプロシージャに追加すればOKです。
画像を消すマクロ
画像表示の前に、表示されている画像を消します。
'////標準プロシージャ//// Sub 画像削除() Dim o As Object For Each o In ActiveSheet.Shapes o.Delete Next End Sub
'////ワークシートのイベントプロシージャ//// Private Sub Worksheet_SelectionChange(ByVal Target As Range) Call 画像削除 Call 画像表示(Cells(Target.Row, 4)) Range("A1") = (Cells(Target.Row, 3)) End Sub
こんな感じです。
ちなみに他にオートシェイプ等があっても全て消してしまう、強力すぎるマクロなので、myShapeに「.Name = "何か名前"」で名前をつけて、画像削除の中で「o.name」が一致する場合に削除、というふうにしたほうが一般的には良いでしょう。*1
1004対策
1004が起こる要因としては
- 空白行がクリックされた
- 画像ファイルのパスが間違っている
- パスはあっているけど画像ファイルじゃない
等が考えられます。
文字列が空白かチェックしたりDir関数でファイルの存在を確認したりもできますが、今回は単純に「表示できない場合は何もしない」ようにします。
'////標準プロシージャ//// Sub 画像表示(imgPath As String) Dim myShape As Shape Dim bairitu As Double On Error GoTo err Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=imgPath, _ Linktofile:=True, _ SaveWithDocument:=False, _ Left:=0, _ Top:=Rows(1).Height, _ Width:=0, _ Height:=0) With myShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue bairitu = Columns(1).Width / .Width .ScaleHeight bairitu, msoTrue .ScaleWidth bairitu, msoTrue End With Exit Sub err: 'MsgBox err.Number & "_" & err.Description End Sub
「On Error GoTo err」で、エラーが起こったら「err:」に飛ぶようにしています。
エラー番号や内容がどうしても見たい場合は「MsgBox err.Number & "_" & err.Description」をコメントから戻せば確認できます。
*1:じゃあそう書けばいいのに