Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Excel 2010)
画像貼り付け
投稿日時: 18/09/10 15:45:52
投稿者: ラングドシャ

お願いいたします。
 
以下のコードでA列のファイル名の画像を検索し、H列に貼り付けています。
A列には関数が入っているため、画像のいらないセルで空白であっても
関数がはいっているため「リンクされたイメージを表示できません。ファイルが移動
または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と
場所が指定されていることが確認してください」と表示された、枠だけの画像が
貼り付けられてしまいます。
どのようにしたら関数が入っていても空白の場合は無視して、処理が次のセルに進みますで
しょうか?
よろしくお願いいたします。
 

Sub 画像挿入()

    Dim myjpg  As Object
    Dim myPath As String
    Dim a As Double, b As Double, aa As Double, bb As Double
    Dim i As Long   
        
    myPath = "\\192.168.100.100\商品画像\"
    
    Application.ScreenUpdating = False
    For i = 2 To Range("A65536").End(xlUp).Row
           
        Set myjpg = _
            ActiveSheet.Pictures.Insert(myPath & Cells(i, 1).Value)
   
        With myjpg
            a = .Height
            b = .Width
            aa = Cells(i, 8).Height
            bb = Cells(i, 8).Width
            
            If a > b Then
                
                .Height = aa
                .Width = b * aa / a
                
                If .Width > bb Then
                    .Height = a * bb / b
                    .Width = bb
                
                End If
            
            Else
                
                .Height = a * bb / b
                .Width = bb
                
                If .Height > aa Then
                    .Height = aa
                    .Width = b * aa / a
                
                End If
            
            End If
            
            .Left = Cells(i, 8).Left + (bb - .Width) / 2
            .Top = Cells(i, 8).Top + (aa - .Height) / 2
        
        End With
        
    Next
    End If
    
    Application.ScreenUpdating = True

End Sub

回答
投稿日時: 18/09/10 16:27:18
投稿者: WinArrow
投稿者のウェブサイトに移動

If Dir(myPath & Cells(i, 1).Value) <> "" Then
で確認するとよいでしょう。

投稿日時: 18/09/10 18:01:32
投稿者: ラングドシャ

WinArrowさん
いつもありがとうございます。
早速追加してみましたが、今まで同様 枠だけの画像が入ってしまいます。
追加した箇所がマズイでしょうか?
 
Sub 画像挿入()
 
    Dim myjpg As Object
    Dim myPath As String
    Dim a As Double, b As Double, aa As Double, bb As Double
    Dim i As Long
             
    myPath = "\\192.168.100.100\商品画像\"
         
    Application.ScreenUpdating = False
    For i = 2 To Range("A65536").End(xlUp).Row
   
   If Dir(myPath & Cells(i, 1).Value) <> "" Then

            Set myjpg = _
            ActiveSheet.Pictures.Insert(myPath & Cells(i, 1).Value)
         
        With myjpg
         
            a = .Height
            b = .Width
            aa = Cells(i, 8).Height
            bb = Cells(i, 8).Width
             
            If a > b Then
                 
                .Height = aa
                .Width = b * aa / a
                 
                If .Width > bb Then
                    .Height = a * bb / b
                    .Width = bb
                 
                End If
             
            Else
                 
                .Height = a * bb / b
                .Width = bb
                 
                If .Height > aa Then
                    .Height = aa
                    .Width = b * aa / a
                 
                End If
             
            End If
             
            .Left = Cells(i, 8).Left + (bb - .Width) / 2
            .Top = Cells(i, 8).Top + (aa - .Height) / 2
                 
        End With
         
     Else
     Exit For
     End If

    Next
        
    Application.ScreenUpdating = True
         
End Sub

回答
投稿日時: 18/09/10 21:30:11
投稿者: WinArrow
投稿者のウェブサイトに移動

>Cells(i, 1).Value
の内容は正しいですか?
 
Debug.print Cells(i, 1).Value
を入れて確認してみてください。
 
 
もう一つ
Exit For
で良いのですか?

回答
投稿日時: 18/09/10 22:11:48
投稿者: WinArrow
投稿者のウェブサイトに移動

もう一つ
 
このコードでは、アクティブシートが対象になっていますが、
 
意図したシートでしょうか?

投稿日時: 18/09/12 11:46:18
投稿者: ラングドシャ

WinArrowさん
 
ありがとうございました。
おかげさまでなんとか処理できました。
シートが一枚でボタンを設置して実行しますので
アクティブシートとなっているのは問題ありません。
 
ありがとうございました。