在图像控制框的用户窗体中创建打印预览

Question

代码应在同一用户窗体上名为 Image1 的图像控制框中显示预览图像。

有滞留

Image1.Picture = LoadPicture(Environ("TEMP") & "\\PrintPreview.png")

我检查了 Temp 目录。它将 PrintPreview.png 文件保存为 PrintPreview.png.pdf，因此无法将其加载到图像控制框。

Private Sub CommandButton8_Click()

    Application.EnableEvents = False
    Me.Hide
    
    ' Create a temporary worksheet to hold the print area
    Dim tempSheet As Worksheet
    Set tempSheet = Sheets.Add
    
    ' Copy the desired range to the temporary sheet
    Worksheets("InputSheet").Range("A1:I31").Copy tempSheet.Range("A1")
    
    ' Set print area for the temporary sheet
    tempSheet.PageSetup.printArea = tempSheet.UsedRange.Address
    
    ' Create a chart to capture a screenshot of the print preview
    Dim tempChart As ChartObject
    Set tempChart = tempSheet.ChartObjects.Add(0, 0, tempSheet.UsedRange.Width, tempSheet.UsedRange.Height)
    
    ' Copy the temporary sheet to the chart
    tempChart.Chart.Paste
    
    ' Export the chart as an image
    tempChart.Chart.Export Environ("TEMP") & "\PrintPreview.png", "PNG"
    
    ' Delete the temporary sheet and chart
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    ' Load the captured image into the Image control
    Image1.Picture = LoadPicture(Environ("TEMP") & "\PrintPreview.png")
    
    ' Show the UserForm again
    Me.Show
    Application.EnableEvents = True

End Sub

我希望 PrintPreview.png 图像出现在同一用户窗体上的图像控制框“Image1”中。

Answer 1

正如 BlackCat 所提到的，VBA 本身并不处理 PNG 文件。

可以使用以下函数，对上面的代码进行最小的更改：

Function LoadImage(ByVal Filename As String) As StdPicture
    With CreateObject("WIA.ImageFile")
        .LoadFile Filename
        Set LoadImage = .FileData.Picture
    End With
End Function

将相关代码行更改为：

Image1.Picture = LoadImage(Environ("TEMP") & "\PrintPreview.png")

Answer 2

我还没有实施，但我知道如何去做。

1. 首先，我创建一个工作表和一个空白图表。
2. 然后我将所需的范围复制到图表中
3. 接下来，我将图表作为 PNG 图像导出到我的 PC 上的目录中
4. 最后我导入到表单上的图像控件中，从而创建预览

将范围复制到图表

Private Sub CommandButton8_Click()

    Dim ws As Worksheet
    Dim chartObject As chartObject
    Dim img As Shape
    Dim inputSheet As Worksheet
    Dim rngToCopy As Range      

    ' Set the worksheet with the chart
    Set ws = ThisWorkbook.Sheets("Sheet28")

    ' Set the chart object
    On Error Resume Next
    Set chartObject = ws.ChartObjects("Chart 3")
    On Error GoTo 0

    ' Set the worksheet with the input data
    Set inputSheet = ThisWorkbook.Sheets("InputSheet")

    ' Set the range to copy
    Set rngToCopy = inputSheet.Range("A1:I31")

    ' Check if the chart object exists
    If Not chartObject Is Nothing Then
        ' Clear existing fill
        chartObject.Chart.ChartArea.Interior.Pattern = xlNone

        ' Copy the range as a picture
        rngToCopy.CopyPicture Appearance:=xlScreen, Format:=xlPicture

        ' Paste the picture onto the worksheet
        ws.Paste

        ' Set the img variable to the newly pasted shape
        Set img = ws.Shapes(ws.Shapes.Count)

        ' Move the image to the chart area
        img.LockAspectRatio = msoFalse
        img.Width = chartObject.Width
        img.Height = chartObject.Height
        img.Top = chartObject.Top
        img.Left = chartObject.Left

        ' Clear the clipboard
        Application.CutCopyMode = False
    Else
        MsgBox "Chart 3 not found on Sheet28", vbExclamation
    End If
End Sub 

将图表导出到图像文件

Sub ExportChartAsPNG()
    Dim myChart As ChartObject
    Dim chartFilePath As String

    ' Set the chart object
    Set myChart = Sheets("Sheet28").ChartObjects("Chart 3")

    ' Specify the file path for the exported PNG image
    chartFilePath = "C:\Path\To\Your\Folder\Chart3.png"  ' Update the path as needed

    ' Export the chart as PNG
    myChart.Chart.Export Filename:=chartFilePath, FilterName:="PNG"

    ' Inform the user about the successful export
    MsgBox "Chart 3 has been exported as PNG to " & chartFilePath, vbInformation
End Sub