| 
    
     |  | selectがよくないのではとselectしない方法で 書き直してみました。
 私の方では、これで画像が1枚貼り付けられましたが・・
 試してみてください。
 
 Private Sub ComboBox1_Change()
 Range("Q6").Value = ComboBox1.Value
 End Sub
 
 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim 保存場所 As String
 Dim 作成者名 As String
 
 If Not Intersect(Target, Range("Q6")) Is Nothing Then
 
 Application.EnableEvents = False
 Application.ScreenUpdating = False
 
 保存場所 = "D:\2.開発中物件\見積書作成\見積システム\"
 作成者名 = 保存場所 & "名刺写し\" & Sheets("見積出").Range("Q6").Value & ".jpg"
 
 With Worksheets("見積出")
 On Error Resume Next
 .Shapes("作成者").Delete
 On Error GoTo 0
 .Shapes.AddPicture(作成者名, False, True, 387, 105, 170, 140).Name = "作成者"
 End With
 '   If Target.Address(0, 0) = "Q6" Then
 '     MsgBox Target.Value
 '   End If
 
 
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 
 End If
 
 End Sub
 
 |  |