将excel文本导出为图像文件答案

【问题标题】：Export excel text as an image file将excel文本导出为图像文件
【发布时间】：2015-01-02 10:02:48
【问题描述】：

我终于能够使用 Excel VBA 将 excel 文本导出为 .jpg 图像文件。我能够找到有关如何将图片/剪贴画导出为图像的文章/帖子/博客，但在文本上找不到任何内容。现在终于可以做到了，导出的图片很模糊。 请告知我如何才能获得良好的图片质量。这是导出的图片。它在excel上看起来不错，但不是图片。我尝试将格式更改为 .png，但差别不大。字体使用 Monotype Corsiva 作为标题，使用 Times New Roman Italics 作为文本。我的文本在 A1:L21 范围内，这是我在 Internet 上某处找到的代码，根据我的需要进行了修改

Option Explicit

Sub ExportMyTextAsPicture()

     Dim MyChart As String, MyPicture As String
     Dim PicWidth As Long, PicHeight As Long

     Application.ScreenUpdating = False
     On Error GoTo Finish

    Range("A1:L21").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    Range("A23").Select
    ActiveSheet.Paste

     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With

     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
           End With

           .Shapes(MyPicture).Copy

           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With

           .ChartObjects(1).Chart.Export Filename:="mymymy.jpg", FilterName:="jpg"
           .Shapes(MyChart).Cut
     End With

     ActiveSheet.DrawingObjects.Select
     Selection.Cut

     Application.ScreenUpdating = True
     Exit Sub

Finish:
     MsgBox "You must select a picture"
End Sub

这是我搜索的原始代码（以防万一）...导出图片/剪贴画。（运行宏前需要选择图片）

Option Explicit

Sub ExportMyPicture()

     Dim MyChart As String, MyPicture As String
     Dim PicWidth As Long, PicHeight As Long

     Application.ScreenUpdating = False
     On Error GoTo Finish


     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With

     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
           End With

           .Shapes(MyPicture).Copy

           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With

           .ChartObjects(1).Chart.Export Filename:="mymymy.jpg", FilterName:="jpg"
           .Shapes(MyChart).Cut
     End With

     Application.ScreenUpdating = True
     Exit Sub

Finish:
     MsgBox "You must select a picture"
End Sub

【问题讨论】：

不相关，但“future”有一个错字，您可能想修正 ;)
感谢您的建议...我会尝试 pdf 的方法

标签： vba excel excel-2007 excel-2010

【解决方案1】：

我也遇到过类似的情况。我在 Excel 中创建了需要创建为图像的信息。图像将始终保存为压缩图像，尤其是字体。它不会将字体保存为抗锯齿。为了解决这个问题，我将其打印/保存为 PDF 文件。

【讨论】：

【解决方案2】：

您还可以使用 VBA 以编程方式保存为 PDF，如 this thread 和 this site 中所述。

【讨论】：