1、使用EXCELVBA實現圖表批量生成并發送業務需求officeword2007的郵件合并功能是財務、文秘類工作經常使用的功能之一，該功能可以生成包含可變內容的批量郵件文檔，廣泛適用于發送工資條、成績單、通知書等，這里不再贅述。筆者所在單位最近為加強員工考核管理工作力度，提出了一個類似于郵件合并功能，但使用郵件合并功能卻不能實現的需求，下面用文字結合圖表描述：1.將員工百分制考核結果批量以圖表（折線圖）反應出來，每一條員工數據均生成一個類似于下圖右側的圖表。圖1）2.使用類似于郵件合并方式實現員工考核圖表的批量發送，將生成的圖表插入郵件正文分別發送給每位員工。圖2）解決思路思路一：使用VS.ne

2、t+Sqlserver（或ACCESS等，下同）開發一個網站，設置好權限，允許員工查看自己的反饋結果。思路評價：可行，但達不到設想中的推送效果。思路二：使用VS.net+Sqlserver開發一個系統，內置圖表模板，圖表基于固定區域數據生成；為每位員工復制一份作為報表，將該員工數據填寫到固定區域；將每位員工的報表作為附件發送給每位員工。思路評價：可行，但開發量大，效果不直觀。思路三：使用VS.net+Sqlserver開發一個系統，使用VS2008版以上自帶控件或第三方控件如dotnetcharting，為每位員工生成一張圖片，將該圖片插入郵件發送給每位員工。思路評價：可行，但開發量大。思路四

3、：使用excelVBA為每位員工生成一張圖片，將該圖片插入郵件發送給每位員工。這個思路一開始并沒有列入考慮范圍，主要原因是當時認為在excel中為每位員工生成一個圖表是不可能的，即使能生成也沒辦法脫離excel工作薄，分別和員工對應起來并發送。最終采用本思路，是緣于筆者發現VBA可以非常容易地把圖表導出為圖片。思路評價：可行，事實證明，開發量比想象的小很多。開發環境準備在運行該程序的電腦上安裝OfficeExcel2007或以上版本；正確配置OUTLOOK使之能夠正常發送郵件；3.打開Excel2007新建工作薄，把測試數據輸入到sheet1工作表，把工作薄保存到工作目錄(為方便后文描述,這里

4、的目錄設為“E:excel-vba”，在該目錄下新建“imgfile”子目錄，以存放圖片。示例數據如下：姓名德能勤績郵件主題郵件地址附件路徑張三0120231620員工考核反饋E:excel-vbaimgfile張三01.jpg張四0225202323員工考核反饋E:excel-vbaimgfile張四02.jpg張五0324162518員工考核反饋E:excel-vbaimgfile張五03.jpg張三0225202323員工考核反饋E:excel-vbaimgfile張三02.jpg張四0325202323員工考核反饋E:excel-vbaimigfile張四03.jpg平均值231922

5、20注意：附件路徑是個公式：=concatenate(“E:excel-vbaimgfile”,A1,”.jpg”)含義是圖片以員工姓名命名，這意味著員工姓名不可重復。4.完成宏安全設置，如圖所示：實現過程這個業務需求實現包含兩個難點，一是為每位員工生成對應的圖片；二是批量發送帶圖片的郵件。基于這兩點，筆者在excel工作薄中設置了兩個按鈕，編寫了兩段代碼，分別對應上述兩個問題。事實上，這兩段代碼完全可以整合到一起，這里為了方便理解，還是分開介紹。筆者采取代碼中加入注釋的方式幫助大家理解代碼含義。第一步，在sheet1中加入兩個按鈕，分別命名為“批量生成圖表”和“批量發送郵件”。第二步，分別為

6、兩個按鈕指定如下宏代碼：Sub批量生成圖表()DimmyChart,RaAsChartObjectDimmyFileNameAsStringDimi,jAsIntegerWithSheet1先虛加一個圖表對象,解決下文循環開頭刪除空集問題SetmyChart=.ChartObjects.Add(520,40,400,250)取數據總行數，第一行為標題，最后一行為平均值j=Sheet1.b65536.End(xlUp).Row從第2行開始循環，i代表第幾行Fori=2Toj-1清除原有圖表.ChartObjects.Delete.指定圖表位置和大小SetmyChart=.ChartObjects

7、.Add(520,40,400,250)WithmyChart.Chart第一個數據系列，員工各項考核值.ChartType=xlLineMarkers.SeriesCollection.NewSeries.SeriesCollection(1).XValues=Sheet1.Range(b1:e1).SeriesCollection(1).Values=Sheet1.Range(b&i&:e&i).SeriesCollection(1).Name=Sheet1.Range(a&i)第二個數據序列，各項考核平均值，位于sheet最后一行.SeriesCollection.NewSeries.S

8、eriesCollection(2).XValues=Sheet1.Range(b1:e1).SeriesCollection(2).Values=Sheet1.Range(b&j&:e&j).SeriesCollection(2).Name=Sheet1.Range(a&j).指定圖表生成的位置.LocationWhere:=xlLocationAsObject,Name:=Sheet1顯示標簽值.ApplyDataLabelsShowValue:=True顯示圖表標題.HasTitle=True.ChartTitle.Text=員工考核反饋.設置圖表標題的字體With.ChartTitle

9、.Font.Size=20.ColorIndex=3.Name=華文新魏EndWith.設置圖表區域的顏色With.ChartArea.Interior.ColorIndex=8.PatternColorIndex=1.Pattern=xlSolidEndWith.設置繪圖區域的顏色With.PlotArea.Interior.ColorIndex=35.PatternColorIndex=1.Pattern=xlSolidEndWith.設置是否顯示Y軸刻度myChart.Chart.HasAxis(xlValue,xlPrimary)=TrueSetmyChart=Sheet1.Chart

10、Objects(1).Chart使用第一列值命名圖像，請勿重復myFileName=Sheet1.Cells(i,1)&.jpgOnErrorResumeNext.刪除原有同名文件KillThisWorkbook.Path&imgfile&myFileName.將圖表轉換為圖像并輸出到指定目錄，使之與H列的值相對應myChart.ExportFilename:=ThisWorkbook.Path&imgfile&myFileName,Filtername:=JPGEndWith.清空對象SetmyChart=NothingNextiEndWithEndSubSub批量發送郵件()要能正確發送并

11、需要對MicroseftOutlook進行有效配置OnErrorResumeNextDimrowCount,endRowNo要正常運行下面這句，要將工具/引用中的MicroseftOutlook12.0ObjectLibrary選上DimobjOutlookAsNewOutlook.ApplicationDimobjMailAsMailItem取得當前工作表與Cells(1,1)相連的數據區行數endRowNo=Cells(1,1).CurrentRegion.Rows.Count創建objOutlook為Outlook應用程序對象SetobjOutlook=NewOutlook.Applic

12、ation開始循環發送電子郵件ForrowCount=2ToendRowNo-1創建objMail為一個郵件對象SetobjMail=objOutlook.CreateItem(olMailItem)WithobjMail設置收件人地址(從通訊錄表的E-mail地址列中獲得).To=Cells(rowCount,7)設置抄送人地址(從通訊錄表的抄送E-mail地址列中獲得).CC=Cells(rowCount,2)設置郵件主題.Subject=Cells(rowCount,6)&(&Cells(rowCount,1)&)設置郵件內容格式，這里選擇HTML.BodyFormat=olFormat

13、HTML設置郵件內容(從通訊錄表的內容列中獲得)，這里的內容本質上是個網頁，可先使用網頁開發工具調整好格式，然后把源碼粘貼到此處.HTMLBody=員工考核反饋(”&Cells(rowCount,1)&”)設置附件(如果以附件形式發送的話，這里選擇不加附件)IfRange(H&rowCount).ValueThen.Attachments.AddRange(H&rowCount).ValueEndIf顯示郵件.Display發送郵件.SendEndWithOnErrorGoTocontinuecontinue:OnErrorGoTo0SetbjOutlook=NothingSetobjMail=NothingNext銷毀objOutlook對象SetobjOutlook=Nothing所有電子郵件發送完成時提示MsgBoxrowCount-2&個員工的反饋信息發送成功！如果發送成功，關閉Excel，這里選擇不退出IfApplication.Workbooks.Count=1ThenApplication.QuitElseWorkbooks(e