Excel vba第二次导出图表模糊

Question

我正在使用 excel vba 执行一些计算。最后，我创建了一个图表并将其放在用户表单上。 在我第一次执行它时，它起作用了。之后，我有一个“重新启动”按钮，它可以重新启动程序（而不终止它）。在我第二次执行代码时，由于某种原因，图片变得模糊。 正如您在下面的代码中看到的那样，我将图片保存在我的文档中，并且它在代码第二次运行时（第一次运行良好）保存图片模糊。 这种行为非常奇怪，我无法理解。 这是我保存图表的代码：

Private Sub ShowGraphButton_Click()
'Creating an image chart, saving it and displaying it in the userform

Dim result As Chart
Dim chart_data As Range
Dim trend As Trendline

'Setting a chart
Set result = Sheet1.Shapes.AddChart(xlXYScatter).Chart
Set chart_data = Sheets("Sheet2").Range("B2:B10000")

'Application.ScreenUpdating = False

'Chart settings
With result
    'Series settings
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = "                       "
    .SeriesCollection(1).Values = chart_data
    .SeriesCollection(1).XValues = Sheets("Sheet2").Range("A2:A10000")
    .SeriesCollection(1).MarkerSize = 12

    'Axes settings
    .Axes(xlCategory, xlPrimary).ReversePlotOrder = False
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Time (seconds)"
    .Axes(xlCategory, xlPrimary).AxisTitle.Font.size = 12
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Text = "StandardDeviation"
    .Axes(xlValue, xlPrimary).AxisTitle.Font.size = 12

    'Area settings
    .ChartArea.Height = 350
    .ChartArea.Width = 600
    .ChartArea.Format.Fill.ForeColor.RGB = RGB(183, 207, 255)

    'Chart title settings
    .HasTitle = True
    .ChartTitle.Text = "StandardDeviation per second"
    .ChartTitle.Characters.Font.Bold = True
    .ChartTitle.Characters.Font.Color = RGB(0, 0, 0)
    .ChartTitle.Characters.Font.Name = "arial"

    'Legend settings
    .HasLegend = True
    .Legend.Position = xlLegendPositionLeft
    .Legend.IncludeInLayout = True
    .Legend.Height = 20
    .Legend.Width = 100

    'Trendline settings
    Set trend = .SeriesCollection(1).Trendlines.Add
    trend.DisplayEquation = True
    trend.DisplayRSquared = True
    trend.DataLabel.Left = 20

End With


'Creates the image
Dim img_name As String
img_name = Application.DefaultFilePath & Application.PathSeparator & "myChart.jpeg"
result.Export Filename:=img_name, Filtername:="jpeg"

'Deletes the chart from sheet1
Sheet1.ChartObjects(1).Delete

GraphForm.Picture = LoadPicture(img_name)

RunningMode.Hide
GraphForm.Show

Application.ScreenUpdating = True
End Sub

如果需要任何其他信息，我会相应地分享。

Answer 1

首先，您可以尝试将图表保存为 png。这通常会在导出时产生更高质量的图像。

模糊的另一个原因可能是图表在导出时太小。尝试在以下代码中增加图表的大小：

.ChartArea.Height = 350
.ChartArea.Width = 600

您还必须增加字体大小，例如在轴标题中，并可能重新定位图例。

另一种选择是将图表导出为 pdf，这是一个矢量文件：

Private Sub btnSavePDF_Click()
Dim Filename As String, myShell As Object
Filename = Application.InputBox("Enter the pdf file name", Type:=2)
ActiveSheet.ChartObjects("RefChart").Activate
ActiveSheet.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard
Set myShell = CreateObject("WScript.Shell")
myShell.Run Filename
End Sub

来源：http://www.vbaexpress.com/forum/archive/index.php/t-33369.html