vba - 范围类的 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)。

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