excel - 从单元格中的图片到页脚

Question

给定这样的工作簿：

我需要在工作表 B、C 的页脚中添加单元格 A2 - 工作表 A 中的徽标。

这是我找到并稍作修改的代码，但它不起作用。

Sub Logo()

Dim printWorksheet As Worksheet
Dim logoShape As Shape
Dim tempImageFile As String

Set printWorksheet = ThisWorkbook.ActiveSheet
Set logoShape = ThisWorkbook.Sheets("A").Shapes("myLogo")

tempImageFile = Environ("temp") & Application.PathSeparator & "image.jpg"
Save_Object_As_Picture logoShape, tempImageFile

With printWorksheet.PageSetup
.RightHeaderPicture.FileName = tempImageFile
.RightHeader = "&G"
End With

标签： excelvbamacos

Answer 1

我找到了一个解决方案（http://www.vbforums.com/showthread.php?538529-Export-an-Image-from-Excel-Sheet-to-Hard-Drive），我已经采用了这个任务。关键是，图表对象可以导出为图片，因此将原始形状复制到图表中。图表被创建、使用和删除。ShapeExportAsPicture 有两个参数：要导出为图片的形状和存储它的完整路径。

Sub Logo()
    Dim printWorksheet As Worksheet
    Dim logoShape As Shape
    Dim tempImageFile As String

    Set printWorksheet = ThisWorkbook.ActiveSheet
    Set logoShape = ThisWorkbook.Sheets("A").Shapes("myLogo")
    logoShape.Visible = True
    tempImageFile = Environ("temp") & Application.PathSeparator & "image.jpg"
    Call ShapeExportAsPicture(logoShape, tempImageFile)

    With printWorksheet.PageSetup
        .RightFooterPicture.Filename = tempImageFile
        .RightFooter = "&G"
    End With
    logoShape.Visible = False
End Sub

Private Sub ShapeExportAsPicture(pShape As Shape, sPathImageLocation As String)
    Dim sTempChart As String
    Dim shTempSheet As Worksheet
    Set shTempSheet = pShape.Parent
    Charts.Add 'Add a temporary chart
    ActiveChart.Location Where:=xlLocationAsObject, Name:=shTempSheet.Name
    Selection.Border.LineStyle = 0
    sTempChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
    With shTempSheet
        'Change the dimensions of the chart to the size of the original shape
        With .Shapes(sTempChart)
            .Width = pShape.Width
            .Height = pShape.Height
        End With
        pShape.Copy  'Copy the shape
        With ActiveChart 'Paste the shape into the chart
            .ChartArea.Select
            .Paste
        End With
        'export the chart
        .ChartObjects(1).Chart.Export Filename:=sPathImageLocation, FilterName:="jpg"
        .Shapes(sTempChart).Delete 'Delete the chart.
      End With
End Sub