Question

我正在尝试自动化将一系列Excel工作表导出为JPEG的过程。

有问题的表格是钻孔日志的监测点，包含单元格中的信息以及显示趋势的图表。导出的JPEG将用于报告。

我从这里拿了代码： Using VBA Code how to export excel worksheets as image in Excel 2003?

稍微修改它以满足我的需要。该脚本捕获数组中的工作表，并逐步完成设置打印区域的数组，以允许原始代码按预期运行。

    Sub ExportImage()

'Place all worksheets in an array

Dim ShtNames() As String
ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
ShtNames(i) = Sheets(i).Name
Next i

Dim sFilePath As String
Dim sView As String


i = 1

'step through each worksheet to export to JPG

Do Until i = Sheets.Count + 1
    Sheets(Sheets(i).Name).Activate

    Sheets(Sheets(i).Name).UsedRange.Select
    ActiveSheet.PageSetup.PrintArea = Selection.Address

'Credit to Winand and Ryan from this link https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003/28541252

'Captures current window view
    sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
    ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
    Application.ScreenUpdating = True

    Set Sheet = ActiveSheet

'Set the file path to export the image to the user's desktop
'I have to give credit to Kyle for this solution, found it here:
'http://stackoverflow.com/questions/17551238/vba-how-to-save-excel-workbook-to-desktop-regardless-of-user
    sFilePath = "C:\temp\Match\JPG\" & ActiveSheet.Name & ".jpg"

'Export print area as correctly scaled PNG image, courtasy of Winand
    zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
    Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
    area.CopyPicture xlPrinter
    Set chartobj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    chartobj.Chart.Paste
    chartobj.Chart.Export sFilePath, "jpg"
    chartobj.Delete

'Returns to the previous view
    ActiveWindow.View = sView

'Re-enables screen updating
    Application.ScreenUpdating = True

i = i + 1
Loop

End Sub

当我单步执行代码时，它按预期工作，但是如果我从按钮单击或快捷方式运行代码，结果图像就是空格。

我在Windows 7计算机上使用Excel 2016。我想也许代码运行得太快了＃34;用于捕获JPEG并放入小＆＃34;睡眠＆＃34;点，但那不起作用。

我可能错过了此代码的替代方案吗？

Answer 1

使用Axel Richter的建议，代码现在运行。我在ChartObj.Activate和.Paste

之前添加了.Export

问题已得到解答。完整代码以下是有需要的人。

Sub ExportImage()

'Place all worksheets in an array

Dim ShtNames() As String
ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
ShtNames(i) = Sheets(i).Name
Next i

Dim sFilePath As String
Dim sView As String

Dim WS As Worksheet, PntRng As Range, OffSetRw As Integer, OffSetClmn As Integer

i = 1

'step through each worksheet to export to JPG

Do Until i = Sheets.Count + 1
    Sheets(Sheets(i).Name).Activate

    Sheets(Sheets(i).Name).UsedRange.Select
    ActiveSheet.PageSetup.PrintArea = Selection.Address

'Credit to Winand and Ryan from this link https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003/28541252

'Captures current window view
    sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
    ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
    Application.ScreenUpdating = False

    Set Sheet = ActiveSheet

'Set the file path to export the image to the user's desktop
'I have to give credit to Kyle for this solution, found it here:
'http://stackoverflow.com/questions/17551238/vba-how-to-save-excel-workbook-to-desktop-regardless-of-user
    sFilePath = "C:\temp\Match\JPG\" & ActiveSheet.Name & ".jpg"
    Dim ChartObj As ChartObject
'Export print area as correctly scaled PNG image, courtasy of Winand
    zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
    Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
    area.CopyPicture xlPrinter
    Set ChartObj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    ChartObj.Activate
    ChartObj.Chart.Paste
    ChartObj.Chart.Export sFilePath, "jpg"
    ChartObj.Delete

'Returns to the previous view
    ActiveWindow.View = sView

'Re-enables screen updating
    Application.ScreenUpdating = True

i = i + 1
Loop

End Sub

将数据和图表从Excel工作表导出到JPG

1 个答案: