一键批量插入图片的2个疑难问题（已解决，方案上传供分享）

yepulu

.LockAspectRatio = msoFalse

lsc900707

感谢分享，下载备用。

movencn

保留、分享

movencn

保留备用，谢谢分享

张frank

学习学习  楼主有在吗。。我最近也是很困扰批量插入图片 适应单元格大小  想学习下

richardsonip123

zjdh 发表于 2014-8-5 18:56
Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim rngTemp As Range, k As Range,  ...

老师，请问这个代码如果要更改，需要把原来的A列单元格插入图片，改为可以给A列的3、4或者多行合并单元格内插入图片该怎么改。其余功能不变。
Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim rngTemp As Range, k As Range, shpPic As Picture
    Set rngTemp = Application.InputBox("图片插入区域：", "选择单元格", Type:=8)
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        FilePath = fd.SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
    For Each k In rngTemp
        With k
            Filename = Dir(FilePath & .Value & "*.jpg")
            If k <> "" And Filename <> "" Then
                ActiveSheet.Shapes.AddPicture FilePath & Filename, False, True, .Left, .Top, .Width, .Height
                .ClearComments
                .AddComment
                .Comment.Shape.Fill.UserPicture FilePath & "\" & .Value & ".jpg"
                .Comment.Shape.Height = 180
                .Comment.Shape.Width = 240
                 Filename = ""
           End If
        End With
    Next
        ActiveSheet.Shapes.SelectAll
        Selection.Placement = xlMoveAndSize
        Range("A1").Select
End Sub
Private Sub CommandButton2_Click()
    ActiveSheet.Range("A:ZZ").ClearComments    '删除选区内的批注
    For Each shp In ActiveSheet.Shapes
        If Not shp.Type = msoOLEControlObject Then shp.Delete
    Next
End Sub

wenxingli

学习的菜鸟路过，感觉这个帖子不错

fzh2618182

也碰到类似问题，看看能否借用一下，谢谢各位！

cosmicdust

感谢分享最终成果，可以拿来就用，很方便

choiwan

老师，插图后排序图片不跟着单元格排序，要怎么办？我用的是EXCEL2010