我有一个子例程可以很好地导出从 Excel 中的某个范围内获取的图像，但我遇到了一个问题...即使我设法使图表对象透明并且没有边框...导出的图像有一个我希望在导出之前裁剪很多未使用的区域。
Sub BtnSaveFile_Click()
Dim RgExp As Range
Dim ImageToExport As Excel.ChartObject
Const sSlash$ = "/"
Const sPicType$ = ".png"
Dim sChartName$
Dim sPath$
Dim sBook$
Set RgExp = Range("G4:N28")
RgExp.CopyPicture xlScreen, xlPicture
Set ImageToExport = ActiveSheet.ChartObjects.Add(Left:=RgExp.Left - 80, Top:=RgExp.Top - 80, Width:=RgExp.Width - 80, Height:=RgExp.Height - 80)
With ImageToExport.Chart.ChartArea.Format.Fill
.Visible = msoFalse
End With
With ImageToExport.Chart.ChartArea.Format.Line
.Visible = msoCFalse
End With
ImageToExport.Chart.Paste
Start:
sChartName = Application.InputBox("Enter A Name Of Your Choice" & vbCr & _
"There Is No Default Name Available" & vbCr & _
"The File Will Be Saved At C:\SECTIONIZER\SAVED SECTION\", "PROVIDE A NAME FOR THE VIEW", "")
If sChartName = Empty Then
MsgBox "Please Enter A File Name", , "Invalid Entry"
GoTo Start
End If
If sChartName = "False" Then
ImageToExport.Delete
Exit Sub
End If
sBook = "C:\SECTIONIZER\SAVED SECTION"
sPath = sBook & sSlash & sChartName & sPicType
ImageToExport.Chart.Export Filename:=sPath, FilterName:="PNG"
ImageToExport.Delete
ExitProc:
Application.ScreenUpdating = True
Set ImageToExport = Nothing
Set RgExp = Nothing
End Sub
我的想法是通过寻找图像每一侧（左、上、右、下）的第一个黑色像素来裁剪它，这样我就可以设置坐标来裁剪空像素，但我还没有找到代码来执行此操作。
EDIT:从OP提供的链接添加图像
由此：
To this:
您需要启动宏录制器，然后将图片裁剪到您喜欢的区域，然后您可以使用子程序中记录的坐标。以下是您将得到的示例
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 196
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 196
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -8