上下文:我正在编写一个具有两个工作表(设备列表和列表输入)的Excel列表文档。我希望用户能够在“输入”表上输入常规文档信息(名称和日期等),并将此数据捕获为快照并插入到左,中和右标题框中。它有两个不同的标题-一个用于第一页,另一个用于后一页。
我在excel 2013 32位代码上编写了代码(并且有效),只是意识到它不适用于任何64位计算机。当我说它不起作用时,是指生成的图像没有出现在标题的打印预览中。
我是VBA的新手,我真的不知道这段代码在哪里失败,但是我认为它可能在.Chart.Paste步骤中。
我研究了其他线程到32到64位转换,但是它们都引用了PtrSafe,我认为这与我的代码无关。
如何更新代码以在64位上运行?
任何建议都非常感谢。 谢谢。
工作簿:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Module1.AddHeaderToAll_FromCurrentSheet
End Sub
Private Sub Workbook_Open()
End Sub
常规(模块1)Save_Object_As_Picture:
Sub AddHeaderToAll_FromCurrentSheet()
Dim ws As Worksheet
Dim tempFilePath As String
Dim tempPFilePath As String
Dim tempTBFilePath As String
Dim tempPic As Shape
Dim tempPrimeroPic As Shape
Dim tempTiBlkPic As Shape
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set tempPic = ThisWorkbook.Sheets("List Inputs").Shapes("RevBlkPic")
Set tempPrimeroPic = ThisWorkbook.Sheets("List Inputs").Shapes("PrimeroPic")
Set tempTiBlkPic = ThisWorkbook.Sheets("List Inputs").Shapes("TiBlkPic")
tempFilePath = Environ("temp") & "\image.jpg"
Save_Object_As_Picture tempPic, tempFilePath
tempPFilePath = Environ("temp") & "\image2.jpg"
Save_Object_As_Picture tempPrimeroPic, tempPFilePath
tempTBFilePath = Environ("temp") & "\image3.jpg"
Save_Object_As_Picture tempTiBlkPic, tempTBFilePath
For Each ws In ActiveWorkbook.Worksheets
'ws.PageSetup.FirstPage.CenterHeaderPicture
'With ActiveSheet.PageSetup.DifferentFirstPageHeaderFooter = True
'First Page Headers
ws.PageSetup.DifferentFirstPageHeaderFooter = True
ws.PageSetup.FirstPage.CenterHeader.Picture.Filename = tempFilePath
ws.PageSetup.FirstPage.CenterHeader.Text = "&G"
ws.PageSetup.FirstPage.RightHeader.Picture.Filename = tempPFilePath
ws.PageSetup.FirstPage.RightHeader.Text = "&G"
ws.PageSetup.FirstPage.LeftHeader.Picture.Filename = tempTBFilePath
ws.PageSetup.FirstPage.LeftHeader.Text = "&G"
'Different Page Headers
ws.PageSetup.RightHeaderPicture.Filename = tempPFilePath
ws.PageSetup.RightHeader = "&G"
ws.PageSetup.LeftHeaderPicture.Filename = tempTBFilePath
ws.PageSetup.LeftHeader = "&G"
ws.PageSetup.CenterHeaderPicture.Filename = tempFilePath
ws.PageSetup.CenterHeader = ""
' ws.PageSetup.RightHeaderPicture.Filename = tempPFilePath
' ws.PageSetup.RightHeader = "&G"
' ws.PageSetup.LeftHeaderPicture.Filename = tempTBFilePath
' ws.PageSetup.LeftHeader = "&G"
Next ws
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub Save_Object_As_Picture(saveObject As Object, imageFileName As String)
'Save a picture of an object as a JPG/JPEG/GIF/PNG file
'Arguments
'saveObject - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
'imageFileName - the .gif, .jpg, or .png file name (including folder path if required) the picture will be saved as
Dim temporaryChart As ChartObject
Application.ScreenUpdating = False
saveObject.CopyPicture xlScreen, xlPicture
Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width + 1, saveObject.Height + 1)
With temporaryChart
.Border.LineStyle = xlLineStyleNone 'No border
.Chart.Paste
.Chart.Export imageFileName
.Delete
End With
Application.ScreenUpdating = True
Set temporaryChart = Nothing
End Sub