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

桐桐的面包树 · 发表于 2024-9-18 09:29

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

鄂龙蒙 · 发表于 2024-9-18 09:42

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

桐桐的面包树 · 发表于 2024-9-18 09:46

本帖最后由桐桐的面包树于 2024-9-18 09:51 编辑

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

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

kevinchengcw · 发表于 2024-9-18 11:14

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

Sub test()
Dim Dic, Ws, Tmp, S$, Arr, N&, I&
Set Dic = CreateObject("scripting.dictionary")
With ThisWorkbook
For Each Ws In .Worksheets
With Ws
.Activate
For Each Tmp In .Shapes
S = Tmp.TopLeftCell.MergeArea.Address
Dic(S) = Dic(S) & vbTab & Tmp.Name
Next Tmp
For Each Tmp In Dic.keys
Arr = Split(Mid(Dic(Tmp), 2), vbTab)
If UBound(Arr) > LBound(Arr) Then
.Shapes(Arr(LBound(Arr))).Select
For I = LBound(Arr) + 1 To UBound(Arr)
.Shapes(Arr(I)).Select False
Next I
Selection.ShapeRange.Group
End If
Next Tmp
End With
Dic.RemoveAll
Next Ws
End With
Set Dic = Nothing
End Sub

复制代码

lss001 · 发表于 2024-9-18 13:41

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

桐桐的面包树 · 发表于 2024-9-18 14:06

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

好像不可以，报错438

桐桐的面包树 · 发表于 2024-9-18 14:14

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

问题已解，谢谢大神

桐桐的面包树 · 发表于 2024-9-18 14:15

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

谢谢大神

lss001 · 发表于 2024-9-18 14:42

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

楼上已经更正代码了

蜗牛等我 · 发表于 2024-9-18 20:59

真的很棒啊优秀厉害厉害

		自动登录	找回密码
密码			免费注册

[求助] VBA对同一单元格内图片进行组合