Image 将范围导出为图像

一段时间以来，我的同事和我一直在使用各种方法创建一个模板，以便轻松制作志愿者空缺表格

理想情况下，负责该项目的人员只需输入详细信息，空缺表就会自动生成

在这一点上，我已经让表单自动完成，但我们仍然需要复制范围并手动将其粘贴到paint中，以将其保存为图像。同样在图片的左上角，仍然有一个非常薄的空白，我们需要调整

所以我的两个问题是：什么样的代码能让我成功地将一个范围（A1:F19）导出为图像（格式对我来说并不重要，除非你们看到（dis）在任何方面的优势），以及薄的空白得到纠正

如果图像保存在与代码执行位置相同的文件夹中，并且文件名为cell J3，这将是理想的选择

我一直在尝试在这里和其他网站上找到的几个宏，但没有任何效果，但这一个对我来说似乎最符合逻辑/实用-归功于；：

嗨！谢谢你的回答！所以我稍微修改了代码，因为创建了一个没有扩展名的文件，在图像的左上方留下了一点空白。结果是：

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

现在，它是完美的，除了一个小细节；现在图像周围有一个（非常非常）薄的灰色边框。这并不是一个大问题，只有训练有素的眼睛才会注意到。如果没有办法摆脱它-没什么大不了的。但以防万一，如果你知道一种方法，那绝对是很棒的

我已经尝试更改这行中的值

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

子测试仪（）
将sht变暗为工作表
Set sht=此工作簿。工作表（“表1”）
出口量程短量程（“B2:H8”）_
ThisWorkbook.Path&“\”&sht.Range（“J3”）值
端接头
子导出范围（rng作为范围，sPath作为字符串）
淡咖啡豆
rng.CopyPicture外观：=xlScreen，格式：=xlPicture
设置cob=rng.Parent.ChartObjects.Add（10,10200200）
'删除可能已自动添加的任何系列。。。
设置sc=cob.Chart.SeriesCollection
当sc.计数>0时执行此操作
sc（1）.删除
环
用棒子
.shaperage.Line.Visible=msoFalse'我已经使用了几个月，但升级到windows 10/excel 2016后，导出的是一个空白图像。发现Excel 2016有点慢，需要一点一点地完成所有工作。。。
与…有关的。。。节不应包含删除方法，粘贴前需要激活图表

像这样：

mychart.Activate
 With mychart
    .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export Filename:=strTempfile, Filtername:="PNG"      
    End With
mychart.Delete

嗨，蒂姆！谢谢！我在我的问题中添加了一点，我想知道您是否愿意看一看？我不知道如何去除边框-您可以尝试修改正在复制的区域上的单元格边框…这确实可以删除边框，但现在图像周围有一个白色（空白）边框。。。这很奇怪，因为原始文件中没有这样的东西，宏会像屏幕上显示的那样捕获工作表，对吗？是否有一些代码可以裁剪图像？因为这可能是最简单的解决办法——只是划掉边界？你应该把问题全部编辑掉，然后把它变成答案。
mychart.Activate
 With mychart
    .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export Filename:=strTempfile, Filtername:="PNG"      
    End With
mychart.Delete