返回列表 上一主題 發帖

[發問] 請問儲存格轉出圖片解析度問題

alex_wu

帖子
60 
主題
18 
精華
0 
積分
83 
點名
0  
作業系統
NT 
軟體版本
OFFICE2003 
閱讀權限
20 
性別
男 
註冊時間
2010-7-9 
最後登錄
2022-1-10 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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
收藏 分享

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-27 
2#
發表於 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

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

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。
返回列表 上一主題