使用VBA實現(xiàn)EXCEL批量生成圖表并發(fā)送

1、-作者xxxx-日期xxxx使用VBA實現(xiàn)EXCEL批量生成圖表并發(fā)送【精品文檔】使用EXCEL VBA實現(xiàn)圖表批量生成并發(fā)送業(yè)務(wù)需求office word2007的郵件合并功能是財務(wù)、文秘類工作經(jīng)常使用的功能之一，該功能可以生成包含可變內(nèi)容的批量郵件文檔，廣泛適用于發(fā)送工資條、成績單、通知書等，這里不再贅述。筆者所在單位最近為加強(qiáng)員工考核管理工作力度，提出了一個類似于郵件合并功能，但使用郵件合并功能卻不能實現(xiàn)的需求，下面用文字結(jié)合圖表描述：1.將員工百分制考核結(jié)果批量以圖表(折線圖)反應(yīng)出來，每一條員工數(shù)據(jù)均生成一個類似于下圖右側(cè)的圖表。（圖1）2.使用類似于郵件合并方式實現(xiàn)員工考核圖表的批

2、量發(fā)送，將生成的圖表插入郵件正文分別發(fā)送給每位員工。（圖2）解決思路思路一：使用VS.net+Sqlserver（或ACCESS等，下同）開發(fā)一個網(wǎng)站，設(shè)置好權(quán)限，允許員工查看自己的反饋結(jié)果。思路評價：可行，但達(dá)不到設(shè)想中的推送效果。思路二：使用VS.net+Sqlserver開發(fā)一個系統(tǒng)，內(nèi)置圖表模板，圖表基于固定區(qū)域數(shù)據(jù)生成；為每位員工復(fù)制一份作為報表，將該員工數(shù)據(jù)填寫到固定區(qū)域；將每位員工的報表作為附件發(fā)送給每位員工。思路評價：可行，但開發(fā)量大，效果不直觀。思路三：使用VS.net+Sqlserver開發(fā)一個系統(tǒng)，使用VS2008版以上自帶控件或第三方控件如dotnetcharting，

3、為每位員工生成一張圖片，將該圖片插入郵件發(fā)送給每位員工。思路評價：可行，但開發(fā)量大。思路四：使用excel VBA為每位員工生成一張圖片，將該圖片插入郵件發(fā)送給每位員工。這個思路一開始并沒有列入考慮范圍，主要原因是當(dāng)時認(rèn)為在excel中為每位員工生成一個圖表是不可能的，即使能生成也沒辦法脫離excel工作薄，分別和員工對應(yīng)起來并發(fā)送。最終采用本思路，是緣于筆者發(fā)現(xiàn)VBA可以非常容易地把圖表導(dǎo)出為圖片。思路評價：可行，事實證明，開發(fā)量比想象的小很多。開發(fā)環(huán)境準(zhǔn)備1.在運行該程序的電腦上安裝Office Excel2007或以上版本；2.正確配置OUTLOOK使之能夠正常發(fā)送郵件；3.打開Exce

4、l2007新建工作薄，把測試數(shù)據(jù)輸入到sheet1工作表，把工作薄保存到工作目錄（為方便后文描述，這里的目錄設(shè)為“E:excel-vba”），在該目錄下新建“imgfile”子目錄，以存放圖片。示例數(shù)據(jù)如下：姓名德能勤績郵件主題郵件地址附件路徑張三012023 16 20 員工考核反饋zhugq-zzuE:excel-vbaimgfile張三01.jpg張四022520 23 23 員工考核反饋zhugq-zzuE:excel-vbaimgfile張四02.jpg張五032416 25 18 員工考核反饋zhugq-zzuE:excel-vbaimgfile張五03.jpg張三022520 2

5、3 23 員工考核反饋zhugq-zzuE:excel-vbaimgfile張三02.jpg張四032520 23 23 員工考核反饋zhugq-zzuE:excel-vbaimgfile張四03.jpg平均值2319 22 20 注意：附件路徑是個公式：=concatenate(“E:excel-vbaimgfile”,A1,”.jpg”) 含義是圖片以員工姓名命名，這意味著員工姓名不可重復(fù)。4.完成宏安全設(shè)置，如圖所示： （圖3）實現(xiàn)過程這個業(yè)務(wù)需求實現(xiàn)包含兩個難點，一是為每位員工生成對應(yīng)的圖片；二是批量發(fā)送帶圖片的郵件?；谶@兩點，筆者在excel工作薄中設(shè)置了兩個按鈕，編寫了兩段代碼，

6、分別對應(yīng)上述兩個問題。事實上，這兩段代碼完全可以整合到一起，這里為了方便理解，還是分開介紹。筆者采取代碼中加入注釋的方式幫助大家理解代碼含義。第一步，在sheet1中加入兩個按鈕，分別命名為“批量生成圖表”和“批量發(fā)送郵件”。第二步，分別為兩個按鈕指定如下宏代碼：Sub 批量生成圖表() Dim myChart, Ra As ChartObject Dim myFileName As String Dim i, j As Integer With Sheet1 先虛加一個圖表對象,解決下文循環(huán)開頭刪除空集問題 Set myChart = .ChartObjects.Add(520, 40, 4

7、00, 250) 取數(shù)據(jù)總行數(shù)，第一行為標(biāo)題，最后一行為平均值 j = Sheet1.b65536.End(xlUp).Row 從第2行開始循環(huán)，i代表第幾行 For i = 2 To j - 1 清除原有圖表 .ChartObjects.Delete .指定圖表位置和大小 Set myChart = .ChartObjects.Add(520, 40, 400, 250) With myChart.Chart 第一個數(shù)據(jù)系列，員工各項考核值 .ChartType = xlLineMarkers .SeriesCollection.NewSeries .SeriesCollection(1).

8、XValues = Sheet1.Range(b1:e1) .SeriesCollection(1).Values = Sheet1.Range(b & i & :e & i) .SeriesCollection(1).Name = Sheet1.Range(a & i) 第二個數(shù)據(jù)序列，各項考核平均值，位于sheet最后一行 .SeriesCollection.NewSeries .SeriesCollection(2).XValues = Sheet1.Range(b1:e1) .SeriesCollection(2).Values = Sheet1.Range(b & j & :e &

9、j) .SeriesCollection(2).Name = Sheet1.Range(a & j) .指定圖表生成的位置 .Location Where:=xlLocationAsObject, Name:=Sheet1 顯示標(biāo)簽值 .ApplyDataLabels ShowValue:=True 顯示圖表標(biāo)題 .HasTitle = True .ChartTitle.Text = 員工考核反饋.設(shè)置圖表標(biāo)題的字體 With .ChartTitle.Font .Size = 20 .ColorIndex = 3 .Name = 華文新魏 End With.設(shè)置圖表區(qū)域的顏色 With .Ch

10、artArea.Interior .ColorIndex = 8 .PatternColorIndex = 1 .Pattern = xlSolid End With.設(shè)置繪圖區(qū)域的顏色 With .PlotArea.Interior .ColorIndex = 35 .PatternColorIndex = 1 .Pattern = xlSolid End With.設(shè)置是否顯示Y軸刻度 myChart.Chart.HasAxis(xlValue, xlPrimary) = True Set myChart = Sheet1.ChartObjects(1).Chart 使用第一列值命名圖像，

11、請勿重復(fù) myFileName = Sheet1.Cells(i, 1) & .jpg On Error Resume Next.刪除原有同名文件 Kill ThisWorkbook.Path & imgfile & myFileName.將圖表轉(zhuǎn)換為圖像并輸出到指定目錄，使之與H列的值相對應(yīng) myChart.Export Filename:=ThisWorkbook.Path & imgfile & myFileName, Filtername:=JPG End With.清空對象 Set myChart = Nothing Next i End WithEnd SubSub 批量發(fā)送郵件(

12、)要能正確發(fā)送并需要對Microseft Outlook進(jìn)行有效配置On Error Resume NextDim rowCount, endRowNo要正常運行下面這句,要將工具/引用中的Microseft Outlook 12.0 Object Library選上Dim objOutlook As New Outlook.ApplicationDim objMail As MailItem取得當(dāng)前工作表與Cells(1,1)相連的數(shù)據(jù)區(qū)行數(shù)endRowNo = Cells(1, 1).CurrentRegion.Rows.Count創(chuàng)建objOutlook為Outlook應(yīng)用程序?qū)ο骃et

13、 objOutlook = New Outlook.Application開始循環(huán)發(fā)送電子郵件For rowCount = 2 To endRowNo - 1創(chuàng)建objMail為一個郵件對象Set objMail = objOutlook.CreateItem(olMailItem)With objMail設(shè)置收件人地址（從通訊錄表的E-mail地址列中獲得）.To = Cells(rowCount, 7)設(shè)置抄送人地址（從通訊錄表的抄送E-mail地址列中獲得）.CC = Cells(rowCount, 2)設(shè)置郵件主題.Subject = Cells(rowCount, 6) & ( &

14、Cells(rowCount, 1) & )設(shè)置郵件內(nèi)容格式，這里選擇HTML.BodyFormat = olFormatHTML設(shè)置郵件內(nèi)容（從通訊錄表的內(nèi)容列中獲得），這里的內(nèi)容本質(zhì)上是個網(wǎng)頁，可先使用網(wǎng)頁開發(fā)工具調(diào)整好格式，然后把源碼粘貼到此處.HTMLBody = 員工考核反饋( & Cells(rowCount, 1) & ) 設(shè)置附件（如果以附件形式發(fā)送的話，這里選擇不加附件）If Range(H & rowCount).Value Then.Attachments.Add Range(H & rowCount).ValueEnd If顯示郵件.Display發(fā)送郵件.SendEnd WithOn Error GoTo continuecontinue: On Error GoTo 0 Set bjOutlook = Nothing Set objMail = NothingNext銷毀objOutlook對象Set objOutlook = Nothing所有電子郵件發(fā)送完成時提示MsgBox rowCount - 2 & 個員工的反饋信息發(fā)送成功！如果發(fā)送成功，關(guān)閉Excel，這里選擇不退出 If Application.Workbooks.Count = 1 Then Application.Quit Else W