求助图片两两组合和批量导出问题，谢谢

li446425169

因工作需要，需要把图片以两两为单位组合起来并且以指定名称导出，谢谢哪位老师的帮助






不好意思，发错论坛了，应该发帖在“VBA开发”论坛里，谢谢老师提供帮助，

鄂龙蒙

一个单元格的2张图片合并在一起导出？

li446425169

鄂龙蒙 发表于 2022-5-13 11:30
一个单元格的2张图片合并在一起导出？

是的，想要的就是这样的效果

limonet

Sub ShapeGroupSave2()
    Dim Pic As Shape, i%, ActiveShape As Shape, UserSelection As Variant
    With CreateObject("scripting.dictionary")
        For Each Pic In Sheet1.Shapes
            .Item(Right(Pic.BottomRightCell.Address, 1)) = Pic.Name & "@" & .Item(Right(Pic.BottomRightCell.Address, 1))
        Next Pic
        For i = 0 To .Count - 1
            ActiveSheet.Shapes.Range(Split(Left(.items()(i), Len(.items()(i)) - 1), "@")).Select
            Selection.ShapeRange.Align msoAlignCenters, msoFalse
            Selection.ShapeRange.Group.Select
            Set UserSelection = ActiveWindow.Selection
            Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
            With ActiveSheet.ChartObjects.Add(Left:=ActiveCell.Left, Width:=ActiveShape.Width, Top:=ActiveCell.Top, Height:=ActiveShape.Height)
                .ShapeRange.Fill.Visible = msoFalse
                .ShapeRange.Line.Visible = msoFalse
                ActiveShape.Copy
                .Activate
                ActiveChart.Paste
                .Chart.Export ThisWorkbook.Path & "\" & Cells(i + 2, 3) & ".png"
                .Delete
            End With
        Next i
    End With
    ActiveWorkbook.Close False
End Sub

limonet

代码在审核，先看图吧。

li446425169

limonet 发表于 2022-5-13 17:26
Sub ShapeGroupSave2()
    Dim Pic As Shape, i%, ActiveShape As Shape, UserSelection As Variant
    ...

谢谢老师，老师理解的过于复杂了，图片组合在一起由操作者自己调整，不用麻烦在代码里使图片自动重叠后再组合，谢谢老师