엑셀 텍스트를 이미지 파일로 내보내기

Excel VBA를 사용하여 엑셀 텍스트를 .jpg 이미지 파일로 내보낼 수있게되었습니다. 그림/클립 아트를 이미지로 내보내는 방법에 대한 기사/게시물/블로그를 찾을 수 있었지만 텍스트에서 아무 것도 찾을 수 없었습니다. 마침내 나는 그것을 할 수 있었고, 수출 된 그림은 흐릿 해졌습니다. 좋은 화질을 얻으려면 어떻게해야합니까?. 다음은 내 보낸 그림입니다. 탁월함은 좋지만 그림은 아닙니다. 차이점이별로없는 .png 형식을 변경해 보았습니다. 글꼴은 제목에 Monotype Corsiva를 사용하고 텍스트에는 Times New Roman Italics를 사용합니다. 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

출처

2014-11-06 Mumbai CabinCrew

관련이 없지만 "future"는 수정하고 싶을 수있는 오타가 있습니다. –

인증서 텍스트에 오타가 있습니다. 나는 비트 맵 접근법이 결코 품질을 제공하지 않을까 우려하지만 어쨌든 .pdf는 훨씬 더 간단 할 수 있습니다. – pnuts

귀하의 조언에 감사드립니다 ... 나는 pdf 접근 방식을 시도 할 것입니다. –