Question

我正在将excel表提取为png文件，提取还可以，但是提取的文件过于缩小，当我将其放大时变得更加模糊，我要将图像附加到邮件中，因此数据应该是清晰可见，任何想法都在哪里更改代码，将下面的宽度和高度更改为几乎50不变

With ChTemp.Parent
   .Width = PicTemp.Width + 8
   .Height = PicTemp.Height + 8

这是代码

Sub check(filename As String, picturename As String)

Dim myWb As Workbook
Dim ws As Worksheet
Dim i, j As Long, LastRow As Integer
'Dim filename As String, picturename As String

Set myWb = Workbooks.Open(filename:=filename)

Worksheets("Sheet1").Activate


Dim FName As String
FName = picturename
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Application.ScreenUpdating = False
Set pic_rng = ActiveSheet.Range("A2:N42")
Set ShTemp = Worksheets.Add
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ChTemp.Paste
Set PicTemp = Selection
With ChTemp.Parent
   .Width = PicTemp.Width + 8
   .Height = PicTemp.Height + 8
End With
ChTemp.Export filename:=picturename, FilterName:="jpg"
'UserForm1.Image1.Picture = LoadPicture(FName)
Kill FName
Application.DisplayAlerts = False
ShTemp.Delete

myWb.Close False


End Sub

Answer 1

在您的情况下，选择内容是图表本身，并且维度不会增加任何内容。并且代码必须将图片粘贴到增加的图表中 ...否则，任何增加都无济于事。

请尝试以下方法：

'what you have in your code...
'.....
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ChTemp.Parent
   .Width = rng.Width + 10
   .Height = rng.Height + 10
End With
ChTemp.Paste
ChTemp.Export filename:=picturename, FilterName:="jpg"
'your code...
'...

增加提取图像的宽度和高度

1 个答案: