VBA对同一单元格内图片进行组合

桐桐的面包树

求助各位大神，VBA如何对多个工作簿同一单元格内（附件A6单元格）图片进行组合

鄂龙蒙

怎样组合？？？？？？？？？？？？

桐桐的面包树

鄂龙蒙 发表于 2024-9-18 09:42
怎样组合？？？？？？？？？？？？

你好，需要将单元格内的两个图组合成一个图

kevinchengcw

虽然很不想用select的方式，但似乎shapes(array())的方式似乎一直无法成功

1. Sub test()
   
2. Dim Dic, Ws, Tmp, S$, Arr, N&, I&
   
3. Set Dic = CreateObject("scripting.dictionary")
   
4. With ThisWorkbook
   
5.   For Each Ws In .Worksheets
   
6.     With Ws
   
7.       .Activate
   
8.       For Each Tmp In .Shapes
   
9.         S = Tmp.TopLeftCell.MergeArea.Address
   
10.         Dic(S) = Dic(S) & vbTab & Tmp.Name
    
11.       Next Tmp
    
12.       For Each Tmp In Dic.keys
    
13.         Arr = Split(Mid(Dic(Tmp), 2), vbTab)
    
14.         If UBound(Arr) > LBound(Arr) Then
    
15.           .Shapes(Arr(LBound(Arr))).Select
    
16.           For I = LBound(Arr) + 1 To UBound(Arr)
    
17.             .Shapes(Arr(I)).Select False
    
18.           Next I
    
19.           Selection.ShapeRange.Group
    
20.         End If
    
21.       Next Tmp
    
22.     End With
    
23.     Dic.RemoveAll
    
24.   Next Ws
    
25. End With
    
26. Set Dic = Nothing
    
27. End Sub

复制代码

lss001

Sub 组合图片()
Dim sht As Object, k%, shp As Shape, arr
For Each sht In ActiveWorkbook.Worksheet
    ReDim arr(1): k = 0
    For Each shp In sht.Shapes
        'If k > 1 Then Exit For
        If shp.Type = 13 Then
            arr(k) = shp.Name
        End If
    Next
    sht.Shapes.Range(arr).Group
    Erase arr
Next
End Sub

桐桐的面包树

lss001 发表于 2024-9-18 13:41
Sub 组合图片()
Dim sht As Object, k%, shp As Shape, arr
For Each sht In ActiveWorkbook.Worksheet

好像不可以，报错438

桐桐的面包树

kevinchengcw 发表于 2024-9-18 11:14
虽然很不想用select的方式，但似乎shapes(array())的方式似乎一直无法成功

问题已解，谢谢大神

桐桐的面包树

lss001 发表于 2024-9-18 12:18
见另帖...................

谢谢大神

lss001

桐桐的面包树 发表于 2024-9-18 14:06
好像不可以，报错438

楼上已经更正代码了

蜗牛等我

真的很棒啊 优秀厉害 厉害