Excel VBA保存截图
我尝试使用VBA代码截取Excel中的工作表，然后将其保存在指定的path中，但是我无法正确保存它…
Sub My_Macro(Test, Path) Dim sSheetName As String Dim oRangeToCopy As Range Dim FirstCell As Range, LastCell As Range Worksheets(Test).Activate Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _ Cells.Find(What:="*", SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Column) Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _ SearchDirection:=xlNext, LookIn:=xlValues).Row, _ Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, LookIn:=xlValues).Column) sSheetName = Test ' worksheet to work on With Worksheets(sSheetName) .Range(FirstCell, LastCell).CopyPicture xlScreen, xlPicture .Export Filename:=Path + Test + ".jpg", Filtername:="JPG" End With End Sub Excel不想在截图后执行方法.Export …。 所以我试图把图片粘贴到一个新的图表中。 Excel将图表图片保存在正确的位置，在图片上显示图表…我也尝试将其粘贴到临时工作表中，但Excel不想将其导出…
任何想法
正忙着LubošSuk的想法。
只需更改图表的大小。 见下面的脚本。
Sub My_Macro(Test, Path) Test = "UNIT 31" Dim sSheetName As String Dim oRangeToCopy As Range Dim FirstCell As Range, LastCell As Range Worksheets(Test).Activate Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _ Cells.Find(What:="*", SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Column) Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _ SearchDirection:=xlNext, LookIn:=xlValues).Row, _ Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, LookIn:=xlValues).Column) sSheetName = Test ' worksheet to work on With Worksheets(sSheetName).Range(FirstCell, LastCell) .CopyPicture xlScreen, xlPicture 'Getting the Range height PicHeight = .Height 'Getting the Range Width PicWidth = .Width ''.Export Filename:=Path + Test + ".jpg", Filtername:="JPG" 'REMOVE THIS LINE End With With Worksheets(sSheetName) 'Creating the Chart .ChartObjects.Add(30, 44, PicWidth, PicHeight).Name = "TempChart" With .ChartObjects("TempChart") 'Pasting the Image .Chart.Paste 'Exporting the Chart .Chart.Export Filename:=Path + Test + ".jpg", Filtername:="JPG" End With .ChartObjects("TempChart").Delete End With End Sub
几个月前，我正在做类似的事情。 我需要做一个特定的范围的截图，并将其导出到文件。 经过几个小时的表头处理，我发现解决scheme与.chart.export这似乎对我最友好的用户。 请看看我的代码，我认为你可以很容易地更新到你的需要。 简单的想法是创build图表，粘贴任何你想要的截图，导出图表到图片，然后删除id。 简单而优雅。 随意问问是否有问题
Sub takeScreen() Dim mainSheet As Worksheet Set mainSheet = Sheets("Input-Output") Dim path As String path = Application.ActiveWorkbook.path Application.ScreenUpdating = False If Dir(path & "\figures\", vbDirectory) = "" Then MsgBox "Directory figures not found. Cannot save image." Exit Sub End If With mainSheet .ChartObjects.Add(30, 44, 765, 868).Name = "exportChart" With .ChartObjects("exportChart") .Chart.ChartArea.Border.LineStyle = xlNone .Chart.ChartArea.Fill.Visible = False mainSheet.Range(mainSheet.Cells(4, "B"), mainSheet.Cells(60, "L")).CopyPicture .Chart.Paste .Chart.Export fileName:=path & "\figures\" & "fatigue_summary.png ", FilterName:="png" End With .ChartObjects("exportChart").Delete End With Application.ScreenUpdating = True End Sub
根据你的评论，我认为你可以从行/列大小和他们的数量计算图表大小。 或者您可以使用单元格的位置和大小属性来调整图表大小。 （ look for .cells().width, .cells().height,.cells().top, .cells().left ）