怎么用VB创建多Sheet的excel(Sheet能重新命名)

如何用VB创建多Sheet的excel(Sheet能重新命名)
比如我有数组:Arr_Name()
创建 Excel文件，保存地址为 str_Excel_File_Address,其中该 Excel的Sheet数量为 Ubound(Arr_Name())+2.
Sheet的命名规则为:
第一个Sheet名:Summary
第二个~最后一个的SheetName为 数组Arr_Name()中的值..
这个如何编写呢..


[解决办法]
是你观察得问题把,用你得代码也完全可以添加,改名,退出excel,退出有个过程,用了点时间(不是立即)
下面得代码也无所谓顺序,都能通过.不过还是应按顺序释放

VB code

Set xlApp = NothingSet xlBook = NothingSet xlSheet = Nothing
[解决办法]
参考
VB code
Private   Sub   PrintButton_Click() On   Error   GoTo   ErrHandle         Dim   xlApp   As   New   Excel.Application         Dim   xlBook   As   New   Excel.Workbook         Dim   xlSheet   As   New   Excel.Worksheet         Dim   strsql   As   String         Dim   rsPict   As   New   ADODB.Recordset                 If   RichTextBox1.Text   =   " "   Then                 MsgBox   "沒有輸入工號﹐每次可輸入9人工號 ",   vbExclamation,   "提醒您 "                 Exit   Sub         End   If                 '19512,21303,24366,33110,51019,67066,76002,85002,99017         Screen.MousePointer   =   11         strsql   =   "SELECT   A.person_no,A.person_name,B.dept_name,A.photo "   &   _                         "   FROM   person   A   LEFT   JOIN   (SELECT   position.position_no,position.name,position.dept_no,dept.name   AS   dept_name   FROM   position   LEFT   JOIN   dept   ON   left(position.dept_no,1)+ '0000 '=dept.dept_no)B "   &   _                         "   ON   A.position_no=B.position_no   "   &   _                         "   where   A.photo   is   not   null   and   A.enable= '1 '   and   A.person_no   in( "   &   RichTextBox1.Text   &   ") "                                 rsPict.Open   strsql,   pubConn,   1,   1         If   rsPict.EOF   Then                 Exit   Sub         End   If                 Set   xlApp   =   CreateObject( "Excel.Application ")         Set   xlBook   =   xlApp.Workbooks.Open( "\\SWEB\Excel\PrintPhoto.xls ")         Set   xlSheet   =   xlBook.Worksheets(2)         xlApp.Visible   =   False         rsPict.MoveFirst         Dim   ZX   As   Single,   ZY   As   Single         Dim   i   As   Integer,   j   As   Integer                 With   Image1                 .Stretch   =   False                 .Visible   =   False                 .Picture   =   LoadPicture( "\\SWEB\datafile\photo\employee\24115.jpg ")                 ZX   =   .Width   /   3000           '假設目標寬度155圖元                 ZY   =   .Height   /   3500         '假設目標高度165圖元               .Stretch   =   True               .Height   =   Int(.Height   /   ZY)               .Width   =   Int(.Width   /   ZX)         End   With                 i   =   0         j   =   0         Do   While   Not   rsPict.EOF                 xlSheet.Shapes.AddPicture   rsPict.Fields(3).Value,   False,   True,   X1(i),   Y1(j),   ZX   *   32,   ZY   *   37                 xlSheet.Shapes.AddPicture   "\\SWEB\datafile\photo\employee\logo.jpg ",   False,   True,   X2(i),   Y2(j),   ZX   *   15,   ZY   *   8                                 xlSheet.Cells(X3(i),   Y3(i))   =   AddSpace(rsPict.Fields(2).Value)                 xlSheet.Cells(X3(i)   +   2,   Y3(i))   =   Space(5)   &   "工號: "   &   rsPict.Fields(0).Value                 xlSheet.Cells(X3(i)   +   3,   Y3(i))   =   Space(5)   &   "姓名: "   &   IIf(Len(rsPict.Fields(1).Value)   =   2,   Left(rsPict.Fields(1).Value,   1)   +   Space(2)   +   Right(rsPict.Fields(1).Value,   1),   rsPict.Fields(1).Value)                 rsPict.MoveNext                 i   =   i   +   1                 j   =   j   +   1         Loop                 xlSheet.Cells(1,   1).Select         xlApp.Visible   =   True                 Set   xlApp   =   Nothing         Set   xlBook   =   Nothing         Set   xlSheet   =   Nothing         Screen.MousePointer   =   0                 Exit   Sub ErrHandle:         MsgBox   "發生意外錯誤,請查看輸入的工號是否正確﹖ ",   vbExclamation,   "提醒您 "         Screen.MousePointer   =   0         End   Sub 
 
[解决办法]
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing