私の電子メールにExcelの画像をカットアンドペーストしようとしていますが、正しく機能していません。

Question

これは面白いです。だから、私はこのテンプレートを共有ポイントのリストからアイテムをロードして、アイテムを使って処理します。

私がする必要があることの1つは、Excel文書のスクリーンショットを取って電子メールに添付して送信できることです。問題は、共有ドライブ上のフォルダにあるテンプレートのExcelドキュメントを使用していることです。このテンプレートから、毎日レポートを作成します。この部分はうまくいきます。ちょうどカットアンドペーストの問題です。これは、テンプレートドキュメントからスクリーンショットを取り出し、それをテンプレートドキュメントに追加するだけです。私が作成したものではありませんこれは必要なものです。とにかく

、私のコード：設計どおりCopyPictureが働いていると仮定すると、

run_date = Date 
    Dim s2 As String 
    s2 = Format(run_date, "MM-dd-yyyy") 
    Dim FS As Object 

Dim FullPath As String 
FullPath = "\\path\Report\Reports\Status Reports\Daily\DailyReportStatusFor" + s2 + ".xlsm" 

     Set objXL = CreateObject("Excel.Application") 
     objXL.DisplayAlerts = False 
     objXL.Application.Workbooks.Open FullPath 
     Set objActiveWkbk = objXL.Application.ActiveWorkbook 

' Where you will enter Sharepoint location path 
    objXL.Application.Workbooks.Open FullPath 



      objXL.ActiveWorkbook.SaveAs Filename:= _ 
       "https://Sharepoint/lists/shared documents/DailyReportStatusFor" + s2 + ".xlsm", FileFormat:=1, CreateBackup:=False 


    Range("'owssvr'!A1:O18").CopyPicture 
    Sheets("Image").Select 
    Range("A1").Select 
    ActiveSheet.Paste 

Dim objOLApp As Object 'Outlook.Application 
Dim outItem As Object 'Outlook.MailItem 
Dim outFolder As Object 'MAPIFolder 
Dim DestFolder As Object 'MAPIFolder 
Dim outNameSpace As Object 'NameSpace 
Dim lngAttachment As Long 
SendFrom = "me@me.com" 
SendTo = "me@me.com" 
ccTo = "me@me.com" 
EmailSubject = "Dashboard - Daily Review Status for " + s2 
EmailBody = "Attached is the Dashboard - Daily Review Status for " + s2 
'Set application settings 
With Application 
.ScreenUpdating = False 
.EnableEvents = False 
End With 

Sheets("Image").Select 
Range("A1").Select 
Set Sendrng = Selection 
With Sendrng 

ActiveWorkbook.EnvelopeVisible = False 
With .Parent.MailEnvelope 
With .Item 

.Subject = EmailSubject 
.To = SendTo 
.CC = ccTo 
.SentOnBehalfOfName = SendFrom  
.Attachments.Add ("\\Path to report\Report\Reports\Status Reports\Daily\DailyReportStatusFor" + s2 + ".xlsm") 
.Body = "Attached is the Dashboard - Daily Review Status for " + s2 
.Send 
End With 
End With 
'Outlook_SendEmail = True 
End With 
    objXL.ActiveWorkbook.Close SaveChanges:=False 


    ' objXL.Application.COMAddIns("AmericanExpress.ExcelMetadataAddin").Connect = True 
    objXL.DisplayAlerts = True 
    Set objActiveWkbk = Nothing 
    objXL.Application.Quit 
    Set objXL = Nothing 
    Set objNet = Nothing 
    Set FS = Nothing 
    Set App = Nothing 
    Set Itm = Nothing 
    End Sub 

Answer 1

、あなたはおそらく

Range("'owssvr'!A1:O18").CopyPicture 

と、この行の前に

Sheets("Image").Select 

後パス

を再開する必要があります

2行の間に行を挿入してください：

Set objActiveWkbk = objXL.Application.Workbooks.Open FullPath