将excel文本导出为图像文件

我终于可以使用Excel VBA将excel文本导出为.jpg图像文件。我能够找到关于如何将图片/剪贴画作为图像导出的文章/帖子/博客，但无法找到任何文本。现在我终于可以做到了，输出的图片模糊不清。 请咨询我怎样才能获得良好的图片质量。这是导出的图片。它看起来不错，但不是照片。我试图改变格式作为.png没有太大的区别。字体使用Monotype Corsiva标题和Times New Roman斜体字标注文字。 enter image description here 我的文字是在范围A1：L21，这里是我的地方发现了被修改按我的需求将excel文本导出为图像文件

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

来源

2014-11-06 Mumbai CabinCrew

无关，但“将来”有一个您可能想要修复的错字;） – 2014-11-06 01:56:23

证书文本中的错字。我担心位图方法永远不会提供高质量的输出，因为无论如何，.pdf可能会简单得多。 – pnuts 2014-11-06 02:00:35

感谢您的建议......我将尝试pdf方法 – 2014-11-06 02:02:34