Ինչպե՞ս տեղադրել մի շարք բջիջներ հաղորդագրության մարմնում որպես պատկեր Excel- ում:
Եթե Ձեզ անհրաժեշտ է Excel- ից նամակ ուղարկելիս մի շարք բջիջներ պատճենել և տեղադրել դրանք որպես պատկեր հաղորդագրության մարմնում: Ինչպե՞ս կարող էիք զբաղվել այս խնդրով:
Տեղադրեք մի շարք բջիջներ էլփոստի մարմնում, որպես պատկեր Excel- ում VBA կոդով
Տեղադրեք մի շարք բջիջներ էլփոստի մարմնում, որպես պատկեր Excel- ում VBA կոդով
Կարող է լինել, որ այս գործը լուծելու համար ձեզ համար ոչ մի այլ լավ մեթոդ չկա, այս հոդվածում պարունակվող VBA կոդը կարող է օգնել ձեզ: Խնդրում եմ արեք այսպես.
1, Միացրեք թերթիկը, որը ցանկանում եք պատճենել և տեղադրել բջիջները որպես պատկեր, պահեք այն ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.
2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլներ Պատուհանը:
VBA կոդ. Տեղադրեք մի շարք բջիջներ էլփոստի մարմնում որպես պատկեր ՝
Sub sendMail()
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
On Error Resume Next
Set xRg = Application.InputBox("Please select the data range:", "KuTools for Excel", Selection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
TempFilePath = Environ$("temp") & "\"
xHTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Hello, this is the data range that you want:<br> " _
& "<br>" _
& "<img src='//cdn.extendoffice.com/cid:DashboardFile.jpg'>" _
& "<br>Best Regards!</font></span>"
With xOutMail
.Subject = ""
.HTMLBody = xHTMLBody
.Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
.To = " "
.Cc = " "
.Display
End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
Dim xShape As Shape
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
.Activate
For Each xShape In ActiveSheet.Shapes
xShape.Line.Visible = msoFalse
Next
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub
ՆշումՎերը նշված կոդում դուք կարող եք փոխել մարմնի բովանդակությունը և էլփոստի հասցեն ըստ ձեր կարիքի:
3. Կոդը տեղադրելուց հետո սեղմեք F5 այս կոդը գործարկելու բանալին, երկխոսության տուփ է բացվում՝ հիշեցնելու համար ընտրելով տվյալների տիրույթը, որը ցանկանում եք տեղադրել էլփոստի մարմնի մեջ որպես նկար, տես սքրինշոթը.
4. Այնուհետեւ կտտացրեք OK կոճակը, և ա հաղորդագրություն պատուհանը ցուցադրվում է, ընտրված տվյալների տիրույթը տեղադրվել է մարմնի մեջ որպես պատկեր, տես սքրինշոթը.
Նշում: Մեջ հաղորդագրություն Դուք կարող եք նաև փոխել հիմնական բովանդակությունը և էլփոստի հասցեները To և Cc դաշտերում, ինչպես ձեզ անհրաժեշտ է:
5, Վերջապես կտտացրեք ուղարկել այս էլ-նամակն ուղարկելու կոճակը:
ՆշումԵթե Ձեզ անհրաժեշտ է տեղադրել մի քանի միջակայք տարբեր աշխատաթերթերից, ստորև ներկայացված VBA կոդը կարող է ձեզ լավություն անել.
Նախ, դուք պետք է ընտրեք բազմաթիվ միջակայքերը, որոնք ցանկանում եք տեղադրել էլփոստի մարմնի մեջ որպես նկարներ, այնուհետև կիրառեք հետևյալ կոդը.
VBA կոդ. տեղադրեք բջիջների մի քանի միջակայք էլփոստի մարմնի մեջ որպես պատկեր.
Sub sendMail()
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
Dim xSheet As Worksheet
Dim xAcSheet As Worksheet
Dim xFileName As String
Dim xSrc As String
On Error Resume Next
TempFilePath = Environ$("temp") & "\RangePic\"
If Len(VBA.Dir(TempFilePath, vbDirectory)) = False Then
VBA.MkDir TempFilePath
End If
Set xAcSheet = Application.ActiveSheet
For Each xSheet In Application.Worksheets
xSheet.Activate
Set xRg = xSheet.Application.Selection
If xRg.Cells.Count > 1 Then
Call createJpg(xSheet.Name, xRg.Address, "DashboardFile" & VBA.Trim(VBA.Str(xSheet.Index)))
End If
Next
xAcSheet.Activate
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
xSrc = ""
xFileName = Dir(TempFilePath & "*.*")
Do While xFileName <> ""
xSrc = xSrc + VBA.vbCrLf + "<img src='cid:" + xFileName + "'><br>"
xFileName = Dir
If xFileName = "" Then Exit Do
Loop
xHTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Hello, this is the data range that you want:<br> " _
& "<br>" _
& xSrc _
& "<br>Best Regards!</font></span>"
With xOutMail
.Subject = ""
.HTMLBody = xHTMLBody
xFileName = Dir(TempFilePath & "*.*")
Do While xFileName <> ""
.Attachments.Add TempFilePath & xFileName, olByValue
xFileName = Dir
If xFileName = "" Then Exit Do
Loop
.To = " "
.Cc = " "
.Display
End With
If VBA.Dir(TempFilePath & "*.*") <> "" Then
VBA.Kill TempFilePath & "*.*"
End If
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "\RangePic\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub
Գրասենյակի արտադրողականության լավագույն գործիքները
Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար: Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...
Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք
- Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
- Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
- Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
