插入图片的自动调整问题

indreaming

lz这个筛选的话，缩略图会跟着筛选吗

dogingate

很好，确实搜索了很久，没有找到方法，看到这个帖子，终于把超链接放到图片上去了，以下是我自己的代码

Sub PicRefreshing()
Application.ScreenUpdating = False
On Error Resume Next

Set sht = Worksheets("汇总表")
nrowsRng = sht.Range("a1").CurrentRegion.Rows.Count
ncolsRng = sht.Range("a1").CurrentRegion.Columns.Count

ans = MsgBox("是否要重新刷新照片？", vbYesNo + vbDefaultButton2, "提示")
Select Case ans
    Case vbYes
        Call 单元格尺寸设置(sht, nrowsRng, ncolsRng)
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "请选择照片所在文件夹"
            If .Show = -1 Then
              newFolderPath = .SelectedItems(1)
            End If
        End With
        Call 图片批量插入(sht, nrowsRng, ncolsRng, newFolderPath)
        MsgBox "图片刷新完毕！"
    Case vbNo
        Exit Sub
End Select

For i = 2 To nrowsRng
    newPicName = Trim(sht.Cells(i, tzpbh))
    newPicPath = newFolderPath & "\" & newPicName
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, tzplj), Address:=newPicPath, ScreenTip:="请点击超链接获取照片", TextToDisplay:=newPicName
Next i

Application.ScreenUpdating = True

End Sub

dogingate

不好意思，发错了，应该是这段

Sub 图片批量插入(sht, nrowsRng, ncolsRng, newFolderPath)
Application.ScreenUpdating = False
On Error Resume Next

sht.Select
For Each pic In sht.Shapes '删除表中原来所有的图片
   pic.Delete
Next
        
Set fso = CreateObject("Scripting.FileSystemObject")
'ARRGS = Split("BMP,RLE,PNG,JPG,", ",") '//可以增加
'picType = "JPG"

For i = 2 To nrowsRng

        sht.Cells(i, tzpslt).Select   '选中这个单元格
        newFilePath = newFolderPath & "\" & Trim(sht.Cells(i, tzpbh))
        If fso.FileExists(newFilePath) = True Then
            sht.Pictures.Insert(newFilePath).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=newFilePath, ScreenTip:="请点击超链接获取照片"
            With Selection
                .Placement = xlMoveAndSize
                .ShapeRange.LockAspectRatio = msoFalse
                .Top = ActiveCell.Top + 5
                .Left = ActiveCell.Left + 5
                .Height = ActiveCell.Height - 10
                .Width = ActiveCell.Width - 10
            End With
'            Exit For  '//插入后不在寻找文件
        End If
   
Next i
Application.ScreenUpdating = True
End Sub

dollyliu

一个文件能横向改，一个文件能竖向改，能否可以横竖方向都能自动变的呢

lidin

mark 学习了。

714719084

楼主，文件没东西的咧？

饕餮之徒sss

请问这样插入的图片能不能用作动态引用呢，应该用什么函数

zetion

是我想要的功能，谢谢