3D Charting support in email

haianh89

New Member
Joined
Jul 3, 2018
Messages
2
Because I just found out VBA, I have found and matched the type of the internet is quite good but also want to add two 3D pie charts, as attached.

Thanks to the support people for the attached file.

Thanks guys so much.
HTML:
Sub GuiMail_NHDT_27062018()    Dim objOutlook, objOutlookMsg, cn, rst As Object    Dim arr As Variant    Dim str1, str2, str3 As String    Dim I As Integer    Set objOutlook = CreateObject("Outlook.Application")    Set objOutlookMsg = objOutlook.CreateItem(0)    Set cn = CreateObject("ADODB.Connection")    Set rst = CreateObject("ADODB.Recordset")    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"    rst.Open ("select * from [DATA 1$]"), cn    arr = rst.GetRows()    rst.Close    For I = Sheet4.[c1] To Sheet4.[d1]        rst.Open ("select [PHI GROSS],[CHI PHI],[PHI NET],[PHI NET LUY KE],[% KH PHI NET 2018] from [Data 1$] where MADV='" & arr(1, I) & "'"), cn, 3        If rst.RecordCount > 0 Then            str1 = rst.GetString(, , "</td><td>", "</tr>")        Else            str1 = ""        End If        rst.Close        rst.Open ("select [Nhan xet 1] from [Data 1$] where MaDv='" & arr(1, I) & "'"), cn        If rst.RecordCount > 0 Then            str2 = rst.GetString(, , "</td><td>", "</tr>")        Else            str2 = ""        End If        rst.Close        rst.Open ("select [Nhan xet 2] from [Data 1$] where MaDv='" & arr(1, I) & "'"), cn        If rst.RecordCount > 0 Then            str3 = rst.GetString(, , "</td><td>", "</tr>")        Else            str3 = ""        End If        If Len(str2) > 0 Then                Set objOutlookMsg = objOutlook.CreateItem(0)        With objOutlookMsg            .To = arr(3, I)            .CC = Sheet4.Range("b3").Value            .Subject = Sheet4.[b5] & arr(4, I)            .HTMLBody = "<strong>" & Sheet4.[a6] & "</strong><br><br>" & Sheet4.[A7] & "<br>" & Sheet4.[A8] & _                            " <br><table border='1'><th>PHÍ GROSS </th><th>CHI PHÍ</th><th>PHÍ NET</th><th>PHÍ NET LUY KE 2018</th><th>% KH PHI NET 2018</th>  <tr>" & _                            str1 & "</table><br>" & Sheet4.[A12] & "</strong><br> " & _                            "</strong><br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & str2 & _                            "<br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & _                            Sheet4.[A15] & "</strong><br><br><br><br><br><br>" & _                            "<strong>" & Sheet4.[A19] & "</strong><br><br>" & _                            "</strong><br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & str3 & _                            "<br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & _                            Sheet4.[A22] & "<br><br>" & _                            Sheet4.[A23] & "<br>" & _                            Sheet4.[A25] & "<br>" & _                            "<strong>" & Sheet4.[A26] & "</strong><br><br>" & _                           Sheet4.[A28] & "<br>"                                            .display  'Or use Send                          'De email gui di luôn (không hien thi len) doi display => send                    End With
        End If        rst.Close    Next End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
send back the code
Code:
Sub GuiMail_NHDT_27062018()    Dim objOutlook, objOutlookMsg, cn, rst As Object
    Dim arr As Variant
    Dim str1, str2, str3 As String
    Dim I As Integer
    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutlookMsg = objOutlook.CreateItem(0)
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
    rst.Open ("select * from [DATA 1$]"), cn
    arr = rst.GetRows()
    rst.Close
    For I = Sheet4.[c1] To Sheet4.[d1]
        rst.Open ("select [PHI GROSS],[CHI PHI],[PHI NET],[PHI NET LUY KE],[% KH PHI NET 2018] from [Data 1$] where MADV='" & arr(1, I) & "'"), cn, 3
        If rst.RecordCount > 0 Then
            str1 = rst.GetString(, , "</td><td>", "</tr>")
        Else
            str1 = ""
        End If
        rst.Close
        rst.Open ("select [Nhan xet 1] from [Data 1$] where MaDv='" & arr(1, I) & "'"), cn
        If rst.RecordCount > 0 Then
            str2 = rst.GetString(, , "</td><td>", "</tr>")
        Else
            str2 = ""
        End If
        rst.Close
        rst.Open ("select [Nhan xet 2] from [Data 1$] where MaDv='" & arr(1, I) & "'"), cn
        If rst.RecordCount > 0 Then
            str3 = rst.GetString(, , "</td><td>", "</tr>")
        Else
            str3 = ""
        End If
        If Len(str2) > 0 Then
        
        Set objOutlookMsg = objOutlook.CreateItem(0)
        With objOutlookMsg
            .To = arr(3, I)
            .CC = Sheet4.Range("b3").Value
            .Subject = Sheet4.[b5] & arr(4, I)
            .HTMLBody = "<strong>" & Sheet4.[a6] & "</strong><br><br>" & Sheet4.[A7] & "<br>" & Sheet4.[A8] & _
                            " <br><table border='1'><th>PHÍ GROSS </th><th>CHI PHÍ</th><th>PHÍ NET</th><th>PHÍ NET LUY KE 2018</th><th>% KH PHI NET 2018</th>  <tr>" & _
                            str1 & "</table><br>" & Sheet4.[A12] & "</strong><br> " & _
                            "</strong><br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & str2 & _
                            "<br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & _
                            Sheet4.[A15] & "</strong><br><br><br><br><br><br>" & _
                            "<strong>" & Sheet4.[A19] & "</strong><br><br>" & _
                            "</strong><br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & str3 & _
                            "<br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font>  " & _
                            Sheet4.[A22] & "<br><br>" & _
                            Sheet4.[A23] & "<br>" & _
                            Sheet4.[A25] & "<br>" & _
                            "<strong>" & Sheet4.[A26] & "</strong><br><br>" & _
                           Sheet4.[A28] & "<br>"
                            
                .display  'Or use Send                          'De email gui di luôn (không hien thi len) doi display => send
        
            End With


        End If
        rst.Close
    Next
 
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top