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

我有一个vbs scropt,我安排在Windows7中使用taskmanager。 vbs脚本打开excel工作簿并运行某个macros。

除了这个例子,我想将工作簿中的图片复制到电子邮件,大多数情况下,这一切都很好。 当我打开工作簿,运行vba ,但当我运行vbs (双击它),我得到一个错误。

这是抛出问题Plage.CopyPictureCopyPicture method of Range class failed

我已经做了一些search,来到这里和这里 。 从这个最好的解决scheme,我可以罚款是通过在我的vbs脚本myExcelWorker.Visible = True这样做

虽然这个工作,这是好的,我想知道是否有另一种方式,而不是可见的? 这里有人有什么想法吗?

注:我不完全明白为什么它的作品,当它是可见的。 我能用剪贴板做什么吗?

————————————————– —————— EDIT1 ——————————- ——————我试着按照下面的注释添加Plage.CopyPicture 2并得到相同的错误Run-time error '-2147417848 (80010108)' Method 'CopyPicture' of Object 'Range' failed我然后按debugging和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 ' eg "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 

我想这可能会给你的方法相同的结果。 我使用的代码是:

 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 

结果:从不同工作表中的一个范围,你得到一张图片到活动页面和一个链接到它的variables(Pic)。

注意:在示例代码中,它是一个合并范围,可以适应您的需求

我面临同样的问题。 问题的根本原因是打印机没有连接。 所以我在一个catch块中使用了xlScreen

 try { activeChart.CopyPicture(Microsoft.Office.Interop.Excel.XlPictureAppearance.xlPrinter, Microsoft.Office.Interop.Excel.XlCopyPictureFormat.xlPicture, Microsoft.Office.Interop.Excel.XlPictureAppearance.xlPrinter); } catch { activeChart.CopyPicture(Microsoft.Office.Interop.Excel.XlPictureAppearance.xlScreen, Microsoft.Office.Interop.Excel.XlCopyPictureFormat.xlPicture, Microsoft.Office.Interop.Excel.XlPictureAppearance.xlScreen); } return;