如何将ShapeRange.group复制为图片

Question

我想在ShapeRange.group上使用CopyPicture。但我在第3行遇到错误。

    1  Dim gfsfd As Shape
    2  Set gfsfd = Selection.ShapeRange.Group
    3  gfsfd.CopyPicture xlPrinter, xlBitmap 'getting error here as below

运行时错误'1004'
应用程序定义或对象定义的错误

Answer 1

根据上传的图片审核您的要求后，我们可以按照以下步骤操作。 1.将图片嵌入到工作表中。如果您不想打扰当前的工作表，请添加隐藏的工作表。嵌入图像的代码可确保图片作为嵌入图像保留在Excel上，如果移动图像，则不会破坏链接损坏的Excel文件。

Sub Embed_picture()
    ' Change picture path as per your requirement
    Set oPic = Application.ActiveSheet.Shapes.AddPicture("C:\my_dir\child1.jpg", False, True, 1, 1, 1, 1)
    oPic.ScaleHeight 1, True
    oPic.ScaleWidth 1, True

    oPic.Top = Range("E10").Top
    oPic.Left = Range("E10").Left
End Sub

1. 在图像上插入TextBox，但在此之前确保选择了图像。合适的文字将被合并到您的短信中，取代“Hello！Good Morning”。我没有格式化Fill.ForeColor等任何东西，可以根据自己的喜好来完成。这是这个阶段的代码。

   Sub TextBox_on_embedded_image()
       ActiveSheet.Shapes.Range(Array("Picture 1")).Select
       ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 207, 260.25, 132.75 _
       , 28.5).Select
       Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "Hello! Good Morning"
       Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 19).ParagraphFormat. _
       FirstLineIndent = 0
       With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 19).Font
           .NameComplexScript = "+mn-cs"
           .NameFarEast = "+mn-ea"
           .Fill.Visible = msoTrue
           .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
           .Fill.ForeColor.TintAndShade = 0
           .Fill.ForeColor.Brightness = 0
           .Fill.Transparency = 0
           .Fill.Solid
           .Size = 11
           .Name = "+mn-lt"
      End With
      Range("K6").Select
   End Sub
   

2. 下一步是将Sheet1上包含嵌入图像的单元格E10：H20的屏幕图像复制到剪贴板上，然后将位图粘贴到Sheet2上的另一个位置。

此阶段的代码是：

Sub copy2clipboard()
   Worksheets("Sheet1").Range("E10:H20").CopyPicture xlScreen, xlBitmap
   Worksheets("Sheet1").Paste _
       Destination:=Worksheets("Sheet2").Range("E6")
End Sub

以下屏幕截图显示了所获得的结果。