vb 中 创建的EXCEL
点击次数：61 次 发布日期：2008-11-06 08:06:42 作者：源代码网
源代码网推荐 源代码网推荐Sub TableToExcel(nTableName As Integer, nTableData() As Integer) 源代码网推荐 FrmQuarterTable.MousePointer = 11 源代码网推荐 On Error Resume Next 源代码网推荐 Dim i As Integer 源代码网推荐 Dim j As Integer 源代码网推荐 Dim strYear As String 源代码网推荐 Dim strSeason As String 源代码网推荐 Dim xlApp, xlBook, xlSheet As Object 源代码网推荐 On Error Resume Next 源代码网推荐 Set xlApp = CreateObject("Excel.Application") 源代码网推荐 Set xlBook = xlApp.Workbooks.Add 源代码网推荐 Set xlsheet1 = xlBook.worksheets(1) 源代码网推荐 xlApp.activewindow.tabratio = 0.9 源代码网推荐 Select Case nTableName 源代码网推荐 Case 11: 源代码网推荐 xlBook.worksheets("sheet1").Select 源代码网推荐 xlApp.activesheet.range("B1:H1").Select 源代码网推荐 xlApp.activecell.formular1c1 = "表1-1 " 源代码网推荐 源代码网推荐 xlApp.selection.Font.Name = "黑体" 源代码网推荐 xlApp.selection.Font.FontStyle = "Bold" 源代码网推荐 xlApp.selection.Font.Size = 18 源代码网推荐 xlApp.selection.merge 源代码网推荐 With xlApp.activesheet.range("a2:i13").Borders "边框设置 源代码网推荐 .LineStyle = 1 "xlBorderLineStyleContinuous 源代码网推荐 .ColorIndex = 5 "边框为黑色=1 源代码网推荐 源代码网推荐蓝色=5 源代码网推荐 .Weight = 2 "xlthin 源代码网推荐 End With 源代码网推荐 With xlBook.worksheets("sheet1") 源代码网推荐 .cells(2, 3) = "新病人(1)": .cells(2, 4) = "复发(2)": 源代码网推荐 源代码网推荐.cells(2, 5) = "追回(3)": 源代码网推荐 源代码网推荐 .cells(2, 6) = "初治失败(4)": .cells(2, 7) = "迁入 源代码网推荐 源代码网推荐(5)": 源代码网推荐 源代码网推荐 .cells(2, 8) = "其他(6)": .cells(2, 9) = "合计(7)" 源代码网推荐 .cells(3, 2) = "初治": .cells(6, 2) = "初治": .cells(9, 源代码网推荐 源代码网推荐2) = "初治" 源代码网推荐 .cells(4, 2) = "复治": .cells(7, 2) = "复治": .cells 源代码网推荐 源代码网推荐(10, 2) = "复治" 源代码网推荐 .cells(5, 2) = "小计": .cells(8, 2) = "小计": .cells 源代码网推荐 源代码网推荐(11, 2) = "小计" 源代码网推荐 .cells(2, 1) = " ": .range("a2:b2").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .cells(3, 1) = "涂阳": .range("a3:a5").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .cells(6, 1) = "涂阴": .range("a6:a8").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .cells(9, 1) = "未查痰": .range("a9:a11").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .cells(12, 1) = "胸膜炎": .range("a12:b12").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .cells(13, 1) = "其他": .range("a13:b13").Select: 源代码网推荐 源代码网推荐xlApp.selection.merge 源代码网推荐 .Columns("f:f").columnwidth = 13 源代码网推荐 源代码网供稿. |
