Excel VBA Footer Image

Question

Есть ли способ использовать код Excel-VBA, чтобы сделать объект изображения на листе, чтобы вставить его в виде нижнего колонтитула. Я попытался сделать это, создав объект диаграммы и вставив его в формат изображения, а затем экспортировав диаграмму в файл изображения и установив изображение в качестве нижнего колонтитула. Есть ли лучший способ вставить объект изображения в качестве изображения нижнего колонтитула, и если да, то как это сделать?

Answer 1

Я начал записывать макросъемку. Я нажал Page Setup, затем Header/Footer, затем Custom Footer. Я щелкнул по центральной части, а затем Format Picture (кнопка с изображением солнца над горами). Я просмотрел изображение и нажал Insert. «& [Изображение]» появилось в центральной части. Я дважды щелкнул OK. Я выключил макрокорректор.

Я напечатал страницу, и выбранное изображение появилось внизу.

Важный код сохранен в записи макросов был:

ActiveSheet.PageSetup.CenterFooterPicture.Filename = _ 
    "C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg" 

Заменить "C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg" с именем файла вашего выбора.

Макро-рекордер, как правило, самый простой способ обнаружения таких утверждений.

Answer 2

Попробуйте это:

Dim ws as Worksheet 
Set ws = Worksheets("YourWorksheetName") 

With ws.PageSetup 
    .CenterFooterPicture = "&G" 'Specifies that you want an image in your footer 
    .CenterFooterPicture.Filename = "C:\Pictures\MyFooterImage.jpg" 'specifies the image file you want to use 

End With 

Код, сгенерированный с помощью записи макросов поможет вам часть пути там, но, как это часто бывает, он не обеспечивает полностью или наиболее подходящее решение. Похоже, вы пытаетесь вставить изображение, сгенерированное Excel (например, диаграмму) в нижний колонтитул? если это так, я считаю, что у вас будет тот же объект, что и изображение, а затем ссылка на этот файл изображения.

Answer 3

Для любого, кто будет смотреть это в будущем, я поделюсь своим кодом, чтобы скопировать диапазон и сохранить его как файл на вашем компьютере, который затем можно добавить в нижний колонтитул. Вы можете устранить любые биты вы не хотите =)

Dim objPic As Shape 
    Dim objChart As Chart 
    Dim strTimeStamp As String 
    Dim strFileDest As String 

20 Sheets(2).Activate 

30 Sheets(2).Columns("R:T").AutoFit 
40 Sheets(2).Rows("17:21").AutoFit 

50 ActiveWindow.DisplayGridlines = False 
60 Call Sheets(2).Range("S17", "U21").CopyPicture(xlScreen, xlPicture) 
70 ActiveWindow.DisplayGridlines = True 

80 Sheets(2).Shapes.AddChart 
90 Sheets(2).Activate 
100 Sheets(2).Shapes.Item(1).Select 

110 Set objChart = ActiveChart 
120 ActiveChart.Parent.Name = "FooterChart" 

    ' For some reason, Excel occasionally tries to make an actual chart out of these strings. 
    ' It's just a nonsensical chart that messes the footer up but I'm having trouble duplicating the issue and figuring out what causes it. 
    ' This should always work. Don't use .Clear, it crashes. 

130 ActiveChart.ChartArea.ClearContents 

140 objChart.Paste 
150 Selection.Name = "FooterImage" 
160 ActiveSheet.ChartObjects("FooterChart").Activate 

170 Sheets(2).Shapes.Item(1).Line.Visible = msoFalse 
180 Sheets(2).Shapes.Item(1).Height = Range("S17", "U21").Height 
190 Sheets(2).Shapes.Item(1).Width = Range("S17", "U21").Width 
200 ActiveChart.Shapes.Range(Array("FooterImage")).Height = Range("S17", "U21").Height 
210 ActiveChart.Shapes.Range(Array("FooterImage")).Width = Range("S17", "U21").Width 

220 Sheets(2).Shapes.Item(1).Height = Sheets(2).Shapes.Item(1).Height * 1.25 
230 Sheets(2).Shapes.Item(1).Width = Sheets(2).Shapes.Item(1).Width * 1.25 
240 ActiveChart.Shapes.Range(Array("FooterImage")).Height = ActiveChart.Shapes.Range(Array("FooterImage")).Height * 1.2 
250 ActiveChart.Shapes.Range(Array("FooterImage")).Width = ActiveChart.Shapes.Range(Array("FooterImage")).Width * 1.2 

260 strTimeStamp = CStr(Format(Now(), "yyyymmddHhNnSs")) 
270 strFileDest = "D:\Temp" & strTimeStamp & ".jpg" 

280 objChart.Export strFileDest 

290 InsertPicture strFileDest 

300 If Len(Dir$(strFileDest)) > 0 Then 
310  Kill strFileDest 
320 End If 

330 Sheets(2).Shapes.Item(1).Delete