|
vb excel編程技巧,實例,格式,合并單元格,表格線,頁面橫向
Dim xlApp As excel.Application
Dim xlBook As excel.Workbook
Dim xlSheet As excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
Dim xRange As excel.Range
Dim m5 As String
Dim msgss As Boolean
'On Error GoTo 99
With xlSheet
If abcd = True Then tmp2 = "臺," Else tmp2 = "個,"
If dataM > 5 Then m5 = " 數量:" & dataM & tmp2 Else m5 = " "
.Cells(1, 1).Value = lb1.Caption & m5 & Label15.Caption
.Cells(2, 1).Value = "基本信息"
.Cells(6, 1).Value = "額定性能" & Chr(10) & Text1.Text & "rpm"
.Cells(11, 1).Value = "堵轉"
.Columns(1).ColumnWidth = 8 '表格寬度
.Columns(2).ColumnWidth = 18 '表格寬度
'.Range(.Cells(1, 1), .Cells(1, 5)).MergeCells = True '合并
.Range(.Cells(2, 1), .Cells(5, 1)).MergeCells = True '合并單元格
.Range(.Cells(6, 1), .Cells(10, 1)).MergeCells = True '合并單元格
.Range(.Cells(11, 1), .Cells(13, 1)).MergeCells = True '合并單元格
.Range(.Cells(1, 1), .Cells(13, dataM + 2)).Borders.LineStyle = xlContinuous '表格線
.Range(.Cells(2, 1), .Cells(13, dataM + 2)).HorizontalAlignment = xlCenter
.Cells(1, 1).Font.Size = 12
.Cells(1, 1).Font.Name = "黑體"
.rowS(1).RowHeight = 30'行高
For i = 2 To 13
.rowS(i).RowHeight = 20
Next
For i = 0 To dataM
.Columns(i + 3).ColumnWidth = 15 '表格寬度
If i <> 0 Then .Cells(2, i + 2).Font.Size = 5
.Cells(2, i + 2).Value = Label1(i).Caption
If dataM > 5 And i <> 0 And abcd = True Then
.Cells(3, i + 2).Value = Trim(Left(Right(Label1(i).Caption, 7), 3))
Else
.Cells(3, i + 2).Value = Label2(i).Caption
End If
If i = 0 Or dataM < 6 Then .Cells(3, i + 2).Value = Label2(i).Caption
.Cells(4, i + 2).Value = Label3(i).Caption
.Cells(5, i + 2).Value = Label4(i).Caption
.Cells(6, i + 2).Value = Label5(i).Caption
.Cells(7, i + 2).Value = Label6(i).Caption
.Cells(8, i + 2).Value = Label7(i).Caption
.Cells(9, i + 2).Value = Label8(i).Caption
.Cells(10, i + 2).Value = Label9(i).Caption
.Cells(11, i + 2).Value = Label10(i).Caption
.Cells(12, i + 2).Value = Label11(i).Caption
.Cells(13, i + 2).Value = Label12(i).Caption
Next
'設置格式
'.Columns(10).NumberFormatLocal = "0.00_ "
.rowS(6).NumberFormatLocal = "0.000_ "
.rowS(7).NumberFormatLocal = "0.0_ "
.rowS(8).NumberFormatLocal = "0.0000_ "
.rowS(9).NumberFormatLocal = "0_ "
.rowS(10).NumberFormatLocal = "0_ "
.rowS(11).NumberFormatLocal = "0.000_ "
.rowS(12).NumberFormatLocal = "0.0_ "
.rowS(13).NumberFormatLocal = "0_ "
'.rowS(7).Hidden = True
'.rowS(8).Hidden = True
'.rowS(10).Hidden = True
'.rowS(12).Hidden = True
'.Names = lb1.Caption
.PageSetup.Orientation = 2'頁面為橫向
End With
98
If toexcel = 1 Then
If abcd = True Then tmp2 = "臺數據 " Else tmp2 = "個數據 "
If dataM > 5 Then
xlBook.SaveAs File1.Path & "\" & Right(lb1.Caption, Len(lb1.Caption) - 5) & "(" & dataM & tmp2 & Text1.Text & "rpm).xls"
msgss = True
tmp = File1.Path & "\" & Right(lb1.Caption, Len(lb1.Caption) - 5) & "(" & dataM & tmp2 & Text1.Text & "rpm).xls"
Else
If Len(pathIs) < 5 Then
xlBook.SaveAs Left(File1.Path, Len(File1.Path) - (Len(File1.Path) - InStrRev(File1.Path, "\"))) & Right(lb1.Caption, Len(lb1.Caption) - 5) & ".xls"
Else
xlBook.SaveAs File1.Path & "\" & pathIs & "(" & Text1.Text & "rpm).xls"
msgss = True
tmp = File1.Path & "\" & pathIs & "(" & Text1.Text & "rpm).xls"
End If
End If
xlBook.Close
If msgss = True Then MsgBox "轉換成功!文件位于 [ " & tmp & " ]"
End
Else
xlApp.Visible = True '顯示表格o
Set xlApp = Nothing '交還控制給Excel
End If
Exit Sub
99 i = 0 '有問題
End Sub
本文來源于Eddy Blog http://www./ , 原文地址：http://www./program/558.html
|
