Question

我有一个vbs scropt，我在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）。

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

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

1 个答案: