От изображения в ячейке до нижнего колонтитула - PullRequest
0 голосов
/ 29 мая 2020

Для такой книги:

enter image description here

Мне нужно добавить lo go из ячейки A2 - рабочий лист A в нижнем колонтитуле листов B, C.

Вот код, который я нашел и немного изменил, но он не работает.

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

1 Ответ

0 голосов
/ 29 мая 2020

Я нашел решение (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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...