excel - 如何在将图像导出到 VBA 2010 之前对其进行裁剪

Question

我有一个子程序可以很好地导出从 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

我的想法是通过在图像的每一侧(左、上、右、下)寻找第一个黑色像素来裁剪它，这样我就可以设置坐标来裁剪出空像素，但我还没有找到这样做的代码。

编辑:从 OP 提供的链接添加图像

由此:



对此:

Answer 1

您需要启动宏记录器，然后将图片裁剪到您喜欢的区域，然后您可以使用子程序中记录的坐标。以下是您将获得的示例

Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 196
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 196
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -8