이미지를 잘 잘라서 내 이메일에 붙여 넣으려고하면 제대로 작동하지 않습니다.

Question

글쎄, 이건 흥미 롭습니다. 그래서 나는이 템플릿을 공유 목록에서 항목을로드하고 항목을 사용하여 작업을 수행합니다.

내가해야 할 일 중 하나는 Excel 문서의 스크린 샷을 찍어 전자 메일에 첨부하여 보낼 수 있다는 것입니다. 문제는 공유 드라이브의 폴더에있는 템플릿 Excel 문서를 사용하고 있다는 것입니다. 이 템플릿에서 저는 매일 보고서를 만듭니다. 이 부분은 제대로 작동합니다. 잘라 붙이기 문제 일뿐입니다. 이것이 작동하는 방식은 템플릿 문서에서 스크린 샷을 가져 와서 방금 만든 템플릿이 아닌 템플릿 문서에 추가하는 것입니다. , 그것은 필요한 것입니다. 어쨌든

, 내 코드 :

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

가정 CopyPicture 설계로, 당신은 아마 경로를 다시 할 필요가 노력하고 있습니다

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

후이 라인 전에

Sheets("Image").Select 

두 줄 사이에 줄을 삽입하십시오.

Set objActiveWkbk = objXL.Application.Workbooks.Open FullPath