snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Private Sub OpenEmailToSend()
Dim olLook As Object 'Start MS Outlook
Dim olNewEmail As Object 'New email in Outlook
Dim strContactEmail As String 'Contact email address
Dim strCustomer As String 'Customer Name
Dim strSite As String 'Site Name
Windows("Daily MFG meeting report.xls").Activate
Sheets("Image Send Mail").Select
Application.CutCopyMode = xlCopy
Selection.Copy
strContactEmail = "xxxxx" 'ตัวแปร mail To
strCc = "xxx" ' ตัวแปร mail CC
strEmailText = strEmailText
strEmailSubject = "Daily Manager Minute of Meeting on " & Format(Date, "DD MMM 'YYYY") & "_NAVANAKORN" '01 Nov.'12_NAVANAKORN"
Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.createitem(0)
strEmailText = "Dear all," & Chr$(13) & _
Chr$(13) & "Pls. see attached file for Daily manager meeting on " & Format(Date, "DD - MMM - YYyy") & Chr$(13) & Chr$(13) & Chr$(13) & Chr$(13)
With olNewEmail 'Attach template
.To = strContactEmail '"Veerapong@mik-denshi.co.th"
.CC = strCc
.Body = strEmailText
.Subject = strEmailSubject
.Attachments.Add (StrPartName & StrFileName)
.display
End With
Set olLook = Nothing
Set olNewEmail = Nothing
End Sub
Private Sub OpenEmailToSend()
Dim olLook As Object 'Start MS Outlook
Dim olNewEmail As Object 'New email in Outlook
Dim strContactEmail As String 'Contact email address
Dim strCustomer As String 'Customer Name
Dim strSite As String 'Site Name
Windows("Daily MFG meeting report.xls").Activate
Sheets("Image Send Mail").Select
Application.CutCopyMode = xlCopy
Selection.Copy
strContactEmail = "XXXx"
strCc = "XXXX"
strEmailText = strEmailText
strEmailSubject = "Daily Manager Minute of Meeting on " & Format(Date, "DD MMM 'YYYY") & "_NAVANAKORN" '01 Nov.'12_NAVANAKORN"
Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.createitem(0)
strEmailText = "Dear all," & Chr$(13) & _
Chr$(13) & "Pls. see attached file for Daily manager meeting on " & Format(Date, "DD - MMM - YYyy") & Chr$(13) & Chr$(13) & Chr$(13) & Chr$(13)
With olNewEmail 'Attach template
.To = strContactEmail '"Veerapong@mik-denshi.co.th"
.CC = strCc
.Body = strEmailText
.Subject = strEmailSubject
.Attachments.Add ("C:\ObjPic.gif")
.display
End With
Set olLook = Nothing
Set olNewEmail = Nothing
End Sub
Sub CopyObjToGIF()
Dim obj As Object
Dim cht As Excel.ChartObject
Const strPath As String = "C:\"
Application.ScreenUpdating = False
Sheets("Image Send Mail").Shapes.Range( _
Array("Picture 111")).Select
Selection.Copy
With Sheets("Image Send Mail")
Set cht = .ChartObjects _
.Add(0, 0, .Range("A1:O39").Width, .Range("A1:O39").Height)
End With
cht.Chart.Paste
cht.Chart.Export strPath & "ObjPic.gif"
cht.Delete
Set cht = Nothing
Set obj = Nothing
Application.ScreenUpdating = True
End Sub
Sub CopyObjToGIF()
Dim obj As Object
Dim cht As Excel.ChartObject
Const strPath As String = "C:\"
Application.ScreenUpdating = False
Sheets("Image Send Mail").Shapes.Range( _
Array("[color=#0000FF]Picture 111[/color]")).Select
Selection.Copy
With Sheets("Image Send Mail")
Set cht = .ChartObjects _
.Add(0, 0, .Range("A1:O39").Width, .Range("A1:O39").Height)
End With
cht.Chart.Paste
cht.Chart.Export strPath & "ObjPic.gif"
cht.Delete
Set cht = Nothing
Set obj = Nothing
Application.ScreenUpdating = True
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
บรรทัดนั้นนำมาจากไหนครับ 