将excel文本导出为图像文件

时间:2014-11-06 01:32:01

标签: excel vba excel-vba excel-2007 excel-2010

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

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

2 个答案:

答案 0 :(得分:1)

我有类似的情况。我在Excel中创建了需要创建图像的信息。图像将始终保存为压缩图像,尤其是字体。它不会将字体保存为抗锯齿。为此,我将其打印/保存为PDF文件。

答案 1 :(得分:0)

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