Excel VBA自定义标头代码可在32位而不是64位上运行

时间:2018-09-12 03:56:49

标签: excel vba

上下文:我正在编写一个具有两个工作表(设备列表和列表输入)的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

0 个答案:

没有答案