vbaに画像を挿入する

Question

私はフォームをExcelフォームに挿入しようとしていますが、フォーム上の送信ボタンを押したときに画像が選択されていないと、実行時エラー '424' 。どうすればこの問題を解決できますか？ ブラウズボタンは以下のとおりです。

Private Sub browse_Click() 
Dim pic As Variant 
pic = Application.FileDialog(msoFileDialogFilePicker) 
With pic 

    .AllowMultiSelect = False 
    .ButtonName = "Submit" 
    .Title = "Select an image file" 
    .Filters.Add "Image", "*.gif;*.jpg;*.jpeg", 1 
    If .Show = -1 Then 



      Me.filepath.Text = .SelectedItems(1) 
      Me.picpreview.PictureSizeMode = fmPictureSizeModeClip 
      Me.picpreview.Picture = LoadPicture(.SelectedItems(1)) 


    Else 


    End If 

    If pic = False Then Exit Sub 

End With 




End Sub 

次に、特定のセルに画像を割り当てるコードを示します。

Cells(emptyrow, 10).Select 
With xlApp.ActiveSheet.Pictures.Insert(picname) 'it is this line the debugger always points to when I submit the form without a picture 
    With .ShapeRange 
     .LockAspectRatio = msoTrue 
     .Height = 150 
    End With 
    .Left = xlApp.ActiveSheet.Cells(emptyrow, 10).Left 
    .Top = xlApp.ActiveSheet.Cells(emptyrow, 10).Top 
    .Placement = 1 
    .PrintObject = True 
End With 

Answer 1

これは画像ユーザーフォームおよび挿入のために働く必要があり、主な変化は、我々はウィンドウピッカー用Office.FileDialogをDimと画像と設定を選択し、代わりに、我々は、単にパスを使用して画像オブジェクトを用いて分離することです。 _Clickの名前を調整する必要があります。

Public PicPath As String 'this is where we'll store the picture path 

Private Sub Browse_Click() 'getting the picture path 

Dim fDialog As Office.FileDialog 
Set fDialog = Application.FileDialog(msoFileDialogFilePicker) 

With fDialog 

    .AllowMultiSelect = False 
    .ButtonName = "Submit" 
    .Title = "Select an image file" 
    .Filters.Add "Image", "*.gif;*.jpg;*.jpeg", 1 

    If .Show = -1 Then 
     PicPath = .SelectedItems(1) 
     'getting picture full path to use when submit click 
    End If 

    If PicPath = "" Then Unload Me 

End With 

End Sub 

Private Sub Submit_Click()'setting picture in active cell 

    If Not PicPath = "" Then 
     CellAddress = ActiveCell.Address 
     With ActiveSheet.Pictures.Insert(PicPath) 
      With .ShapeRange 
       .LockAspectRatio = msoTrue 
       .Height = 150 
      End With 
      .Left = ActiveSheet.Range(CellAddress).Left 
      .Top = ActiveSheet.Range(CellAddress).Top 
      .Placement = 1 
      .PrintObject = True 
     End With 
     picselectedbool = True 
    Else 
     msgbox ("Please select a picture") 
    End If 

    If picselectedbool Then 
     Unload Me 
    End If 

End Sub