標題: [發問] 請問儲存格轉出圖片解析度問題 [打印本頁]

---

作者: alex_wu    時間: 2019-12-25 12:06     標題: 請問儲存格轉出圖片解析度問題

目的: 將儲存格內容轉出清楚文字之圖片檔
現況問題: 可輸出圖片檔 , 但內容不夠清楚
1.目前可將EXCEL儲存格輸出為圖片之VBA語法,但輸出之解析度不佳
2.但是原儲存格內的內容又無法做異動,字体變大或儲存格重編排 , 異動需要花費數個月大量工時重新排版
3.網路爬文查可以加入放大比例的功能 , 但只有圖框變大
    .ShapeRange.ScaleWidth 1.1, 0
4.想請教各位先進,有無可提升輸出圖示解析度之方法


Sub Ex()
    Dim Rng As Range
    '指定的範圍
    Set Rng = Range("D3:G9")
    Rng.CopyPicture Format:=xlBitmap
   
    '新增 圖表
    With ActiveSheet.ChartObjects.Add(1, 1, Rng.Width, Rng.Height)
         .ShapeRange.ScaleWidth 1.1, 0
         .ShapeRange.ScaleHeight 1.1, 0
         '貼上 圖片
         .Chart.Paste
         '匯出 圖片
         .Chart.Export Filename:="D:\Test.Png"
         '刪除 圖表
         .Delete

    End With
End Sub

---

作者: 准提部林    時間: 2019-12-29 09:53

Sub Ex()
Dim Rng As Range, Shp As Shape
'指定的範圍
Set Rng = Range("D3:G9")
Rng.CopyPicture Format:=xlPicture '不要用xlBitmap
ActiveSheet.Paste '先貼出圖片
Set Shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
Shp.LockAspectRatio = msoTrue '保持圖片比例
Shp.Width = Shp.Width * 2 '放大圖片倍數
Shp.Copy
'新增 圖表
With ActiveSheet.ChartObjects.Add(1, 1, Shp.Width, Shp.Height)
    '.ShapeRange.ScaleWidth 1, 0
    '.ShapeRange.ScaleHeight 1, 0
     .Chart.Paste '貼上 圖片
     .Chart.Export Filename:=ThisWorkbook.Path & "\Test.jpg" '匯出 圖片
     .Delete '刪除圖表
End With
Shp.Delete '刪圖片
End Sub

==================================

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)