将范围导出为图像
一段时间以来，我和我的同事一直在用各种方法创build一个模板，轻松做出志愿者的空缺表格。
理想情况下，项目负责人只能input详细信息，自动生成空缺表格。
在这一点上，我尽可能自动完成表格，但我们仍然需要复制范围，并将其粘贴到绘图手动将其保存为图像。 同样在图像的左上angular，还有一个非常薄的左空白区域，我们必须调整。
所以我的两个问题是：什么代码会使我成功实现将范围（A1：F19）作为图像导出（格式对我无关紧要，除非你们在任何情况下看到（不））优点）白色空间得到纠正？
如果将图像保存在与执行代码相同的文件夹中，并且文件名将是单元格J3的文件名，那将是理想的。
我一直在尝试我在这里和其他网站上find的几个macros，但是无法做任何工作，但是这个macros看起来对我来说最为逻辑/实用 – 称为“ 我们的香蕉人” 使用VBA代码如何在Excel 2003中将Excel工作表导出为图像？ ：
dim sSheetName as string dim oRangeToCopy as range Dim oCht As Chart sSheetName ="Sheet1" ' worksheet to work on set oRangeToCopy =Range("B2:H8") ' range to be copied Worksheets(sSheetName).Range(oRangeToCopy).CopyPicture xlScreen, xlBitmap set oCht =charts.add with oCht .paste .Export FileName:="C:\SavedRange.jpg", Filtername:="JPG" end with 嗨！ 感谢您的回答！ 所以我稍微修改了一下代码，因为没有扩展名的文件被创build，并且在图像的顶部和左边留下了一点点的空白。 这是结果：
Sub Tester() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Activiteit") ExportRange sht.Range("A1:F19"), _ ThisWorkbook.Path & "\" & sht.Range("J3").Value & ".png" End Sub Sub ExportRange(rng As Range, sPath As String) Dim cob, sc rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200) 'remove any series which may have been auto-added... Set sc = cob.Chart.SeriesCollection Do While sc.Count > 0 sc(1).Delete Loop With cob .Height = rng.Height .Width = rng.Width .Chart.Paste .Chart.Export FileName:=sPath, Filtername:="PNG" .Delete End With End Sub
现在除了一个小细节之外，它是完美的。 图像现在有一个（非常非常）薄的灰色边框。 这不是什么大问题，只有训练有素的人才会注意到。 如果没有办法摆脱它 – 没有biggie。 但是，以防万一，如果你知道一个绝对好的方法。
我试过改变这一行的值
Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200)
到-10，但这似乎没有帮助。
编辑：添加一行以从chartobject周围删除边框
Sub Tester() Dim sht as worksheet Set sht = ThisWorkbook.Worksheets("Sheet1") ExportRange sht.Range("B2:H8"), _ ThisWorkbook.Path & "\" & sht.Range("J3").Value End Sub Sub ExportRange(rng As Range, sPath As String) Dim cob, sc rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200) 'remove any series which may have been auto-added... Set sc = cob.Chart.SeriesCollection Do While sc.Count > 0 sc(1).Delete Loop With cob .ShapeRange.Line.Visible = msoFalse '<<< remove chart border .Height = rng.Height .Width = rng.Width .Chart.Paste .Chart.Export Filename:=sPath, Filtername:="PNG" .Delete End With End Sub