通过窗体向表格插入图片

3190496160

dragon0901 发表于 2022-7-13 16:56
谢谢您了。

仅供参考，自己测试看看吧

dragon0901

3190496160 发表于 2022-7-13 18:18
Private Sub CommandButton1_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
     ...

大神，万分感谢，就是这个效果，但是点击插入图片后，表格就自动从sheet1跳转到sheet3了，怎么取消呢，一直显示在sheet1中。谢谢啦

3190496160

dragon0901 发表于 2022-7-15 09:45
大神，万分感谢，就是这个效果，但是点击插入图片后，表格就自动从sheet1跳转到sheet3了，怎么取消呢，一 ...

删除这句代码
Sheet3.Select

hj1989619

3190496160 发表于 2022-7-15 09:54
删除这句代码
Sheet3.Select

大佬，我把您的代码改了一下，为什么老是报错？这一行ws.Pictures.Insert(f).Select提示运行时错误1004，不能取得类Pictures的Insert属性

修改以后的代码如下：
Private Sub CommandButton2_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False   '单选择
        .Filters.Clear   '清除文件过滤器
        .Filters.Add "Excel Files", "*.jpg;*.xlw"
        .Filters.Add "All Files", "*.*"          '设置两个文件过滤器
        If .Show <> -1 Then Exit Sub  'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。
        f = .SelectedItems(1)
    End With
Image1.Picture = LoadPicture(f)
Label10.Caption = f
Image1.PictureSizeMode = fmPictureSizeModeStretch
End Sub
Private Sub CommandButton1_Click()
    Dim lastCell As Range
    Dim lastRow As Long
    Dim targetRange As Range
    Dim ws As Worksheet
   
    Set ws = ThisWorkbook.Sheets("其他")
   
    With ws

         ' 从A列往下找到最后一个有内容的单元格
        Set lastCell = ws.Range("A:A").Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        
        ' 获取起始行号和结束行号
            lastRow = lastCell.Row
            
             MsgBox "lastRow=" & lastRow, vbInformation
   
         ' 设置目标范围为Sheet "其他"中的E列对应的单元格（最后一行的下一行）
             Set targetRange = ws.Range("E" & lastCell.Row + 1)
        
        
    End With
   
    ' 在Sheet "其他"中插入之前选择的图片文件f，并对插入的图片进行设置
    ws.Pictures.Insert(f).Select
        With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = targetRange.Left
            .Top = targetRange.Top
            .height = targetRange.height
            .width = targetRange.width
        End With
   
End Sub

hj1989619

hj1989619 发表于 2023-5-30 16:00
大佬，我把您的代码改了一下，为什么老是报错？这一行ws.Pictures.Insert(f).Select提示运行时错误1004， ...

自己找到原因了……
模块一里少了对f的定义