VBA 关于在可见单元格中，SELECTION选择的部分列单元格批量插入图片到相应的列单元...

kangkumbong

大家好！ 求教



VBA 关于在可见单元格中，SELECTION选择的部分列单元格批量插入图片到相应的列单元格方法


在非隐藏筛选则很正常


FOR循环中
If rng.EntireRow.Hidden = False And rng.EntireColumn.Hidden = False Then 也不起作用
插入的并非是选择的单元格啊，而是其他单元格，不知该如何修改代码
非常感谢！！！求教！！！





Sub 选择单元格名称插入图片()
On Error Resume Next
Application.ScreenUpdating = True
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then
    t = fd.SelectedItems(1)
Else
    MsgBox "未选择文件夹，程序结束"
    Exit Sub
End If
Dim Rng As Range, Shp As Shape
n = InputBox("请输入插入图片的列")

For Each Rng In Selection
        dz = t & "\" & Rng.value & ".jpg"
        z = Rng.Offset(0, n).Left
        d = Rng.Offset(0, n).Top
        k = Rng.Offset(0, n).Width
        G = Rng.Offset(0, n).Height
        ActiveSheet.Shapes.AddPicture dz, 1, 1, z, d, k, G
Next Rng
Call 图片居中
ActiveCell.Select
'    ActiveCell.Offset(0, 0).Select '定位到当前活动单元格   ，  定位到当前活动单元格下一行单元格 ActiveCell.Offset(1, 0)
MsgBox "图片导入数量 " & ActiveSheet.Shapes.Count & "个" '统计图片数量
Application.EnableEvents = True   '让事件生效
Application.ScreenUpdating = True
End Sub

taller

你要实现什么效果？没有示例文件，大家看不懂你的需求

kangkumbong

已上传 测试文件，望参考给与请教 谢谢

taller

1. Sub 选择单元格名称插入图片()
   
2.     ' 不要使用OERN，除非必需
   
3.     'On Error Resume Next
   
4.     Application.ScreenUpdating = True
   
5.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
6.     If fd.Show = -1 Then
   
7.         t = fd.SelectedItems(1)
   
8.     Else
   
9.         MsgBox "未选择文件夹，程序结束"
   
10.         Exit Sub
    
11.     End If
    
12.     Dim rng As Range, Shp As Shape, cell As Range
    
13. '    n = InputBox("请输入插入图片的列")
    
14.     N = 3 ' 测试
    
15.     Dim rTab As Range: Set rTab = Range("A1").CurrentRegion.Columns(2)
    
16.     Set rTab = rTab.Resize(rTab.Rows.Count - 1).Offset(1)
    
17.     Dim rVis As Range
    
18.     On Error Resume Next
    
19.     Set rVis = rTab.SpecialCells(xlCellTypeVisible)
    
20.     On Error GoTo 0
    
21.     If rVis Is Nothing Then Exit Sub
    
22.     If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
23.     For Each rng In rVis  ' 不要依赖于Selection，可能导致误操作
    
24.         dz = t & "" & rng.Value & ".jpg"
    
25.         If Len(Dir(dz)) > 0 Then
    
26.             Z = rng.Offset(0, N - 2).Left
    
27.             d = rng.Offset(0, N - 2).Top
    
28.             k = rng.Offset(0, N - 2).Width
    
29.             G = rng.Offset(0, N - 2).Height
    
30.             ActiveSheet.Shapes.AddPicture dz, 1, 1, Z, d, k, G
    
31.         Next
    
32.     Next rng
    
33.     Call 图片居中
    
34. '    ActiveCell.Select 这句代码没有意义
    
35.     '    ActiveCell.Offset(0, 0).Select '定位到当前活动单元格   ，  定位到当前活动单元格下一行单元格 ActiveCell.Offset(1, 0)
    
36.     MsgBox "图片导入数量 " & ActiveSheet.Shapes.Count & "个" '统计图片数量
    
37.     Application.EnableEvents = True   '让事件生效
    
38.     Application.ScreenUpdating = True
    
39. End Sub

复制代码

kangkumbong

非常感谢 ！！指导！！！