☰

将 Excel 相机图片导出为 PNG 文件

tag-icon • tag-icon microsoft-excel vba
将 Excel 相机图片导出为 PNG 文件

我有一个工作簿，里面有两个对象 - 图表和引用此图表的相机图片 - 也许您可以建议如何将相机图片导出为 PNG 文件？PNG 文件名应取自单元格 - 例如 image1..

我有这段代码但它似乎不起作用：

option explicit

sub biy_comara()
    dim spath as string
    dim rrng as object, sht as object
    
    set sht = thisworkbook.worksheets("sheet1")
    spath = thisworkbook.path & "\" & sht.range("d1").value & ".png"
    set rrng = sht.range("a2:c60")
    rrng.copypicture appearance:=xlscreen, format:=xlpicture
    
    with rrng.parent.chartobjects.add(10, 10, 200, 200)
        .shaperange.line.visible = msofalse
        .height = rrng.height
        .width = rrng.width
        .chart.paste
        .chart.export filename:=spath, filtername:="png"
        .delete
    end with
end sub

答案1

这可能不是你想听到的，但目前这是正确的答案：

Excel VBA 对象模型没有用于此操作的命令。不久前才将此命令添加到 Excel 上下文菜单中，以便右键单击对象，但 VBA 对象模型尚未进行调整以反映这一点。

目前尚不清楚今后是否会添加这样的命令。

答案2

上述宏有效地克服了 excels vba 的限制，并使用单元格值作为 png 名称将相机图像导出为 png - 我只需要将相机图像移动到新的完整清晰工作表，并将相机聚焦在原始叠加图表上。

答案3

我的 Excel VBA 解决方案

  1. 范围.选择
  2. 范围.复制图片
  3. 粘贴
  4. 剪切并存储到系统剪贴板（关键点）
  5. 在一行中创建 Windows Powershell 命令
  6. 通过 Shell 执行 powershell
Sub 巨集1()
 PicDir = ActiveWorkbook.Path & "\"
 PicFile = Format(Now(), "hh-mm") & ".png"
    Sheets("工作表1").Select
    Range("Q1:U10").CopyPicture Appearance:=xlScreen, Format:=xlPicture '複製範圍成圖檔
    ActiveSheet.Paste '要利用這動作-1，才會真的存到 Clipboard
    ActiveSheet.Shapes.Range(Array(Selection.ShapeRange.Name)).Select '選剛貼上的 Shape
    Selection.Cut '要利用這動作-2，才會真的存到 Clipboard
    sPSCmd = "powershell $img = get-clipboard -format image ; $img.Save('" & PicDir & PicFile & "')" '把 Clipboard 內容存成圖檔的 PowerShell
    RetVal = Shell(sPSCmd, 0) '無聲無息的執行
End Sub

相关内容