使用 VBA 将表格数据/格式保存为 PNG

问题描述 投票:0回答:1

我目前正在尝试使用 vba 从 Excel 保存格式化的数据范围。我运行一个单独的宏来填充范围并格式化数据。然后我使用一个按钮来运行一个宏,该宏应该将范围保存为 PNG。该宏大约可以在一半的时间内保存正确的图像。另一半,代码运行没有错误,但保存空白白色图像而不是格式化范围。无法判断它是否会保存图像或空白白色。当进入代码时,当我将范围作为图片复制到临时图表上时,似乎会出现问题。再说一次,没有办法知道它在每次运行中是否有效。

目前,我正在使用这些步骤。

'define the range to be selected
     Set = rng = Worksheets("Whatver Sheet I'm Using").range("A1:E1)"  

'get the save location
     filepath = Application.GetSaveAsFilename(FileFilter:="PNG Files (*.png), *png", Title:="Save As")

'Add a temporary worksheet
Set tempsheet = Worksheets.Add

'check to see if the user decided to cancel the save
If filepath = "False" Then
     MsgBox ("Operation Cancelled")
     Exit Sub
End If

'create a chart
    Charts.Add
    ActiveChart.Location where:=xlLocationAsObject, Name:=tempsheet.Name


'paste range onto the chart
    rng.CopyPicture appearance:=xlScreen, Format:=xlPicture
    
    Set tempchart = ActiveChart
    tempchart.Paste

'modify the chart
    Set temppic = Selection
    With tempchart.Parent
        .Width = temppic.Width
        .Height = temppic.Height
    End With

'export the chart
    tempchart.Export filepath


'delete temporary objects without questioning the user
    Application.DisplayAlerts = False
    tempsheet.Delete
    Application.DisplayAlerts = True

'cleanup
    Application.CutCopyMode = False

我没有使用dim来定义任何东西,老实说我不明白什么时候使用dim合适或不合适。进入代码显示,当使用“tempchart.paste”粘贴图表时,将粘贴格式化范围或粘贴空白白色范围。我不确定问题是出在此处还是其他地方。如果有人提出不同方法的建议,我也愿意重新考虑我的方法。如有任何帮助,我们将不胜感激。

excel vba png save-image
1个回答
0
投票

除了上面的评论,试试这个

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim wsTemp As Worksheet
    Dim rng As Range
    Dim FilePath As Variant
    Dim objChrt As ChartObject
    
    '~~> This is the worksheet which has the range
    Set ws = Worksheets("Whatver Sheet I'm Using")
    '~~> Define the range to be selected
    Set rng = ws.Range("A1:E1")
    
    '~~> Get the save location
    FilePath = Application.GetSaveAsFilename(FileFilter:="PNG Files (*.png), *png", Title:="Save As")
    
    '~~> Check if user pressed cancel
    If FilePath = False Then
        MsgBox ("Operation Cancelled")
        Exit Sub
    End If
    
    '~~> Add a temp worksheet
    Set wsTemp = Worksheets.Add
    
    With wsTemp
        Set objChrt = .ChartObjects.Add(100, 100, rng.Width, rng.Height)
        
        '<~~ In some cases you may have to use .Select (eeesh!!!). Else the image will not paste.
        objChrt.Select
        
        '~~> Do the copy just before paste.
        rng.CopyPicture appearance:=xlScreen, Format:=xlPicture
        
        DoEvents
        objChrt.Chart.Paste
        DoEvents
    End With
    
    'export the chart
    objChrt.Chart.Export FilePath

    'delete temporary objects without questioning the user
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    'cleanup
    Application.CutCopyMode = False
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.