同时将多个图像从Excel导出到我的工作簿

Question

大家好，我叫毛里齐奥（Maurizio），我的问题是： 在Excel工作表上，我插入了5个（形状）带有其他图像。 然后按照您的帖子是这样的：

我只能在工作簿中选择和导出一张图像；虽然我想将它们全部导出 无论是否选择它们，我在这里的所有内容都会减少。 您可以帮我一下。谢谢 毛里齐奥（A. Maurizio）的问候

Sub Esporta_Immagini()
     Dim MyChart As String, MyPicture As String, oShape As Variant
     Dim PicWidth As Long, PicHeight As Long
     Dim strImageName
     Dim oDia
     Dim oChartArea  
     Application.ScreenUpdating = False
     On Error GoTo finish
     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With
     Charts.Add
     ActiveChart.Location WHERE:=xlLocationAsObject, Name:="Foglio1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
                 .Copy
           End With
           .Shapes(MyPicture).Copy
           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With
           .ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Oggetti_Immagini_Salvate\MyPic1.jpg", FilterName:="jpg"
           .ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Oggetti_Immagini_Salvate\MyPic2.jpg", FilterName:="jpg"
           '.ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Oggetti_Immagini_Salvate\MyPic3.jpg", FilterName:="jpg"
           '.ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Oggetti_Immagini_Salvate\MyPic4.jpg", FilterName:="jpg"
           '.ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Oggetti_Immagini_Salvate\MyPic5.jpg", FilterName:="jpg"
           .Shapes(MyChart).Cut
     End With
     For Each oShape In ActiveSheet.Shapes
    strImageName = ActiveSheet.Cells(oShape.TopLeftCell.Row, 1).Value
    oShape.Select
    'Picture format initialization
    Selection.ShapeRange.PictureFormat.Contrast = 0.5: Selection.ShapeRange.PictureFormat.Brightness = 0.5:
    Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic:
    Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse: Selection.ShapeRange.Fill.Visible = msoFalse:
    Selection.ShapeRange.Line.Visible = msoFalse: Selection.ShapeRange.Rotation = 0#:
    Selection.ShapeRange.PictureFormat.CropLeft = 0#: Selection.ShapeRange.PictureFormat.CropRight = 0#:
    Selection.ShapeRange.PictureFormat.CropTop = 0#: Selection.ShapeRange.PictureFormat.CropBottom = 0#:
    Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft:
    Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft 
    '/Picture format initialization
    Application.Selection.CopyPicture
    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height)
    Set oChartArea = oDia.Chart
    oDia.Activate   
    With oChartArea.Export
        .ChartArea.Select
        .Paste
        .Export = ThisWorkbook.Path & ("\Oggetti_Immagini_Salvate\MyPic1.jpg" & strImageName & ".jpg")        
    End With
    oDia.Delete 'oChartArea.Delete
Next
     Application.ScreenUpdating = True
     Exit Sub
finish:
     MsgBox "Devi Selezionare Una Immagine"
End Sub