范围类的 CopyPicture 方法失败 - 使用 vbs 脚本

Question

我有一个vbs 脚本，我在 windows7 中使用 taskmanager 进行调度。 vbs 脚本打开一个 excel 工作簿并运行某个宏。

这对于大多数情况都非常有效，除了这个我想将工作簿中的图片复制到电子邮件的示例。当我打开工作簿并运行vba 时vba 工作正常，但是当我运行vbs（双击它）时出现错误。

这是 Plage.CopyPicture 和 CopyPicture method of Range class failed 引发问题的行

我对此进行了一些搜索，并找到了here 和here。从这个我可以做的最好的解决方案是在我的vbs 脚本myExcelWorker.Visible = True

虽然这很好用，但我想知道是否有另一种方法而不使其可见？这里有人有什么想法吗？

注意：我不完全理解为什么它在可见时会起作用。剪贴板有什么我可以做的吗？

------------------------------------------ ------------------------ EDIT1------------- ------------------------ 我尝试按照下面的评论添加Plage.CopyPicture 2 并得到了同样的错误 Run-time error ‘-2147417848 (80010108)’ Method ‘CopyPicture’ of Object ‘Range’ failed 然后按调试，VB 编辑器出现错误，我再次按 f8 并收到此错误 Run-time error ‘1004’: CopyPicture method of Range class failed

以下是我的脚本仅供参考：

VBS 脚本：

'need to update WBName & MacroName here as this is fairly generic

dim WshShell
set WshShell = CreateObject("Wscript.Shell")

dim strPath
strPath = WshShell.CurrentDirectory 

Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")

'myExcelWorker.Visible = True ' this makes excel visible 

dim oWorkBook
dim WBName

WBName = "\WBwithMacro.xlsm" 'WB to be opened  

dim MacroName 
MacroName = "'" & strpath & WBName & "'!UpdateChart_EDW_LTE" 'Macro Name to be run 

'Write Start+strPath to log file
Call WriteLog("Start_XXX",strPath,"var3")

'Write Mid+strPath+WBName to log file
Call WriteLog("Mid___XXX",strpath & WBName,"var3")

'open WB for running macro
'set oWorkBook = myExcelWorker.Workbooks.open(strpath & WBName) 'for WB WITHOUT password 
Set oWorkBook = myExcelWorker.Workbooks.Open(strpath & WBName,,,,"","Password") 'for WB with password

'Write MacroName to log file
Call WriteLog("Mid___XXX",MacroName,"var3")

myExcelWorker.Run MacroName

myExcelWorker.DisplayAlerts = False 'this is required so the WB will save without being prompted 

oWorkBook.Save
oWorkBook.Close

myExcelWorker.DisplayAlerts = True ' set it back to true again as it is good practice

myExcelWorker.Quit

'Write End to log file
Call WriteLog("End___XXX","t2","t3")

set oWorkBook = Nothing
set myExcelWorker = Nothing
set WshShell = Nothing

'sub to write to log file
Sub WriteLog(var1, var2, var3)

Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")

'Wscript.Echo "VBSStart.vbs is running" 
Dim ObjFso
Dim StrFileName
Dim ObjFile
Dim FlName 

'WScript.Echo var1 & ",,,," & var2 

FlName = "TestFile.txt"
StrFileName = objShell.CurrentDirectory & "\" & FlName
Set ObjFso = CreateObject("Scripting.FileSystemObject")

'Creating a file for writing data
set ObjFile = ObjFso.OpenTextFile(StrFileName, 8, True) 

 'Writing a string into the file
ObjFile.WriteLine(var1 & "," & var2 & "," & var3 & "," & now)

'Closing the file
ObjFile.Close

' Using Set is mandatory
Set objShell = Nothing

End Sub

VBA 部分（在 excel 工作簿中）：

Function createPng(Namesheet, nameRange, nameFile)
    Debug.Print "Namesheet: " & Namesheet
    Debug.Print "nameRange: " & nameRange
    Debug.Print "nameFile: " & nameFile

    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "png"
    End With

    Debug.Print Environ$("temp") & "\" & nameFile & ".png", "png"

    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Function

Sub sendMail()
        Application.Calculation = xlManual
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        Dim TempFilePath As String
        Dim wsName, rngForImg, fnForImg As String ' e.g. "Sheet1", "B2:I27", "BasicSendEmail"
        wsName = "DM"
        rngForImg = "A1:N32"
        fnForImg = "DM" 'this will be basically the name of the Img

        Debug.Print "wsName: " & wsName ' the ws name
        Debug.Print "rngForImg: " & rngForImg ' the range you want in the Img
        Debug.Print "fnForImg: " & fnForImg ' the name you want for the Img

        'Create a new Microsoft Outlook session
        Set appOutlook = CreateObject("outlook.application")
        'create a new message
        Set Message = appOutlook.CreateItem(olMailItem)


        With Message
            .Subject = "PNG My mail auto Object PNG" & Now

            .HTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello,<br ><br >The weekly dashboard is available " _
                & "<br>Find below an overview :<BR>"

            'first we create the image as a png file
            Call createPng(wsName, rngForImg, fnForImg)
            'we attached the embedded image with a Position at 0 (makes the attachment hidden)
            TempFilePath = Environ$("temp") & "\"
            Debug.Print "TempFilePath: " & TempFilePath
            .Attachments.Add TempFilePath & fnForImg & ".png", olByValue, 0

            'Then we add an html <img src=''> link to this image
            'Note than you can customize width and height - not mandatory

            .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
                & "<img src='cid:" & fnForImg & ".png '" & "><br>" _
                & "<br>Best Regards,<br>Ed</font></span>"

            .To = "a@a.com; a@a.com;"
            .Cc = "a@a.com;"

            .Display
            .Send
        End With

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        Application.Calculation = xlCalculationAutomatic
    End Sub

Answer 1

我认为这可能会产生与您的方法相同的结果。 我使用的代码是：

Dim Pic As Shape

With ThisWorkbook.Sheets("Temp")
    .Visible = True
    .Range("F5").MergeArea.Copy
    ActiveSheet.Pictures.Paste(Link:=True).Select

    If TypeName(Selection) = "Picture" Then Set Pic = Selection.ShapeRange.Item(1)
end with

结果：从不同工作表中的范围，您会得到一张图片到活动工作表，以及一个链接到它的变量 (Pic)。

注意：在示例代码中它是一个合并范围，适应你的需要