如何将Userform中的图像控件复制粘贴到Excel工作表

方案1：直接拼接控件对应图片到工作表（最优，清晰度最高） #

该方案不需要截图，直接调用Userform里Image控件已加载的图片源拼接，画质无损失、性能更好。
实现步骤：

• 把Userform里4个门框图像控件的Picture属性对应的图片，临时导出到系统临时目录
• 按拼接位置依次插入到工作表的同一区域，设置对齐和位置，最后组合成单个图形对象方便管理
• 操作完成后删除临时导出的图片文件
  示例VBA代码：

Sub ExportDoorToWorksheet()
    Dim tempPath As String, imgPaths(1 To 4) As String
    Dim i As Integer, shp As Shape, shps() As Shape
    Dim targetSheet As Worksheet
    ' 修改为你的目标工作表名
    Set targetSheet = ThisWorkbook.Worksheets("门预览")
    tempPath = Environ("TEMP") & "\"
    
    ' 导出Userform里4个Image控件的图片到临时目录，示例假设4个控件名为imgFrame1/2/3/4
    For i = 1 To 4
        imgPaths(i) = tempPath & "frame" & i & ".png"
        SavePicture Config.Controls("imgFrame" & i).Picture, imgPaths(i)
    Next i
    
    ' 依次插入图片，位置和尺寸与Userform里的相对位置保持一致
    ReDim shps(1 To 4)
    For i = 1 To 4
        Set shp = targetSheet.Shapes.AddPicture(Filename:=imgPaths(i), _
            LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
            Left:=100 + Config.Controls("imgFrame" & i).Left, _
            Top:=100 + Config.Controls("imgFrame" & i).Top, _
            Width:=Config.Controls("imgFrame" & i).Width, _
            Height:=Config.Controls("imgFrame" & i).Height)
        Set shps(i) = shp
        Kill imgPaths(i) '删除临时文件
    Next i
    
    ' 组合所有图片为单个对象
    targetSheet.Shapes.Range(Array(shps(1).Name, shps(2).Name, shps(3).Name, shps(4).Name)).Group
End Sub

注意：如果Image控件加载的是带透明通道的PNG图片，普通SavePicture默认导出BMP会丢失透明效果，可替换为GDI+相关API实现透明导出。

方案2：Userform指定区域截图（实现简单，兼容性好） #

你提到的截图思路完全可以实现，适合不想处理多图片拼接逻辑的场景。
实现步骤：

• 先显示Userform，确保要截图的区域没有被其他窗口遮挡
• 调用Windows API获取Userform的句柄，对指定区域进行截图并复制到剪贴板
• 直接粘贴到目标工作表即可
  示例VBA代码：

Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long

Sub CaptureUserformDoorArea()
    Dim frmHwnd As LongPtr, frmDC As LongPtr
    Dim captureWidth As Long, captureHeight As Long
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("门预览")
    
    frmHwnd = Config.hWnd ' 部分VBA版本需用API查找Userform句柄，大部分情况可直接取hWnd属性
    frmDC = GetDC(frmHwnd)
    
    ' 设置截图区域尺寸，对应门图像拼接后的总宽高，可直接取4个控件的最大边界
    captureWidth = 400 ' 修改为实际宽度
    captureHeight = 600 ' 修改为实际高度
    
    ' 创建临时画布，截图后复制到剪贴板
    With ThisWorkbook.Worksheets.Add
        .Shapes.AddShape(msoShapeRectangle, 0, 0, captureWidth, captureHeight).Select
        ' 10,10是Userform里门区域的左上角坐标，按实际调整
        BitBlt Selection.ShapeRange.DrawingObject.hDC, 0, 0, captureWidth, captureHeight, frmDC, 10, 10, vbSrcCopy
        Selection.Copy
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    ' 粘贴到目标工作表，目标位置可自行修改
    targetSheet.Paste Destination:=targetSheet.Range("B2")
    ReleaseDC frmHwnd, frmDC
End Sub

注意：该方案要确保Userform处于激活显示状态、不能最小化，否则会截取到空白内容，如果需要后台截图可替换为PrintWindow API实现。

内容的提问来源于stack exchange，提问作者keyv108