关于ADO的使用～
目前我程序中某一小块的SUB程式码如下～请教高手要如何改写成ADO的方式做到同样的功能呢？
程序代码：
Private Sub WriteDataToExcel(Target As String)
Dim xlApp As EXCEL.Application, xlBook As EXCEL.Workbook, xlsheet As EXCEL.Worksheet
Dim i As Integer, j As Integer, k As Integer, StartNum As Integer, StartNum1 As Integer
Dim TempString As String, Temp() As String, CodeString As String, Text As String
Dim AllFailCount1 As Integer, AllFailCount2 As Integer, FailCount1() As Integer, FailCount2() As Integer, iCount As Integer
On Error GoTo ErrorHandling
Set xlApp = CreateObject("Excel.Application")
' xlApp.Visible = True
xlApp.Visible = False
xlApp.DisplayAlerts = False '把Excel的警告訊息關掉
Set xlBook = xlApp.Workbooks.Add
Set xlsheet = xlBook.Sheets(1)
xlsheet.Activate
xlsheet.Cells.HorizontalAlignment = xlCenter
StartNum = 1 '行
StartNum1 = 1 '列
iCount = 2
ReDim FailCount1(AllIC - 1): ReDim FailCount2(AllIC - 1)
AllFailCount1 = 0: AllFailCount2 = 0
With xlsheet
.Select
.Cells.Font.Name = "Tahoma" '設定字型
.Cells.Font.Size = 12 '設定字體大小
.Cells.Borders.LineStyle = xlContinuous
.Cells.Borders.Weight = xlThin '設定儲存格間框線粗細
.Cells.Borders.ColorIndex = 15 '設定儲存格框線顏色
xlApp.ActiveWindow.Zoom = 75 '設定縮放大小
For i = 0 To UBound(DataBase.E_SubList) + 2
If i < 2 Then Call PictureBorder(StartNum + i, StartNum1 + 0, StartNum + i, AllIC * 2 + 3, xlsheet)
For j = 0 To 2 + AllIC * 2
If i = 0 Then
With .Range(.Cells(StartNum + i, StartNum1 + 0), .Cells(StartNum + i, AllIC * 2 + 3))
If j = 0 Then
xlsheet.Cells(StartNum + i, StartNum1 + j) = "Sub"
ElseIf j = 1 Then
xlsheet.Cells(StartNum + i, StartNum1 + j) = "Hardware Bin"
ElseIf j = 2 Then
xlsheet.Cells(StartNum + i, StartNum1 + j) = "Soft Bin"
ElseIf j > 2 Then
If j Mod 2 = 1 Then
xlsheet.Cells(StartNum + i, StartNum1 + j + 0) = "#" & (j - iCount)
iCount = iCount + 1
ElseIf j Mod 2 = 0 Then
xlsheet.Range(xlsheet.Cells(StartNum + i, StartNum1 + j - 1), xlsheet.Cells(StartNum + i, StartNum1 + j)).Merge
End If
End If
End With
ElseIf i = 1 Then
With .Range(.Cells(StartNum + i, StartNum1 + 0), .Cells(StartNum + i, AllIC * 2 + 3))
.Select
.Interior.Color = RGB(153, 204, 255)
.Font.Bold = True
If j = 2 Then
xlsheet.Range(xlsheet.Cells(StartNum + i, StartNum1 + j - 2), xlsheet.Cells(StartNum + i, StartNum1 + j)).Merge
ElseIf j > 2 Then
If j Mod 2 = 1 Then
.Cells(StartNum, StartNum1 + j) = "AAA"
ElseIf j Mod 2 = 0 Then
.Cells(StartNum, StartNum1 + j) = "BBB"
End If
End If
End With
Else
If j = 0 Then
If i - 2 <= UBound(DataBase.E_SubList) Then
.Cells(StartNum + i, StartNum1 + j) = Trim(Mid(DataBase.E_SubList(i - 2).SubName, 1, InStr(DataBase.E_SubList(i - 2).SubName, ",") - 1))
Call PictureBorder(StartNum + i, StartNum1 + j, StartNum + i, StartNum1 + j, xlsheet)
End If
ElseIf j = 1 Then
.Cells(StartNum + i, StartNum1 + j) = Trim(Mid(DataBase.E_SubList(i - 2).SubName, InStr(DataBase.E_SubList(i - 2).SubName, ",") + 1, InStrRev(DataBase.E_SubList(i - 2).SubName, ",") - InStr(DataBase.E_SubList(i - 2).SubName, ",") - 1))
Call PictureBorder(StartNum + i, StartNum1 + j, StartNum + i, StartNum1 + j, xlsheet)
ElseIf j = 2 Then
.Cells(StartNum + i, StartNum1 + j) = Trim(Mid(DataBase.E_SubList(i - 2).SubName, InStrRev(DataBase.E_SubList(i - 2).SubName, ",") + 1))
Call PictureBorder(StartNum + i, StartNum1 + j, StartNum + i, StartNum1 + j, xlsheet)
ElseIf j > 2 Then
If j Mod 2 = 1 Then
.Cells(StartNum + i, StartNum1 + j) = DataBase.E_SubList(i - 2).E_ICList((j \ 2) - 1)
If DataBase.E_SubList(i - 2).E_ICList((j \ 2) - 1) = "1" Then FailCount1((j \ 2) - 1) = FailCount1((j \ 2) - 1) + 1
Text = "123" & Chr(10) & "456"
Call CellsWriteComment(StartNum + i, StartNum1 + j, StartNum + i, StartNum1 + j, Text, xlsheet)
.Cells(StartNum + i, StartNum1 + j + 1) = DataBase.E_SubList(i - 2).F_ICList((j \ 2) - 1)
If DataBase.E_SubList(i - 2).F_ICList((j \ 2) - 1) = "1" Then FailCount2((j \ 2) - 1) = FailCount2((j \ 2) - 1) + 1
Text = "789" & Chr(10) & "456"
Call CellsWriteComment(StartNum + i, StartNum1 + j + 1, StartNum + i, StartNum1 + j + 1, Text, xlsheet)
End If
End If
End If
MyDoEvents
Next j
MyDoEvents
Next i
j = i
.Cells(StartNum + j + 1, StartNum1 + 0) = "Total Fail"
For i = 0 To UBound(FailCount1)
.Cells(StartNum + j + 1, StartNum1 + 3 + i * 2) = FailCount1(i)
.Cells(StartNum + j + 1, StartNum1 + 3 + i * 2 + 1) = FailCount2(i)
AllFailCount1 = AllFailCount1 + FailCount1(i)
AllFailCount2 = AllFailCount2 + FailCount2(i)
Next i
.Cells(StartNum + j + 3, StartNum1 + 0) = "Sum"
.Cells(StartNum + j + 3, StartNum1 + 1) = AllFailCount1
.Cells(StartNum + j + 3, StartNum1 + 2) = AllFailCount2
.Cells(StartNum + j + 5, StartNum1 + 0) = "Note : "
.Cells(StartNum + j + 5, StartNum1 + 1) = "0->Pass"
.Cells(StartNum + j + 5, StartNum1 + 2) = "1->Fail"
.Cells(StartNum + j + 5, StartNum1 + 3) = "0->None"
.Range("D3").Select
ActiveWindow.FreezePanes = True
.Columns("A:A").HorizontalAlignment = xlGeneral
.Columns("A:A").VerticalAlignment = xlCenter
.Columns("A:A").ColumnWidth = 43.13
.Columns("B:B").ColumnWidth = 13.88
.Columns("C:C").ColumnWidth = 13.88
End With
If IsFolderExist(txtTargetPath.Text) = False Then MkDir txtTargetPath.Text
If IsFileExist(Target) = True Then Target = Mid(Target, 1, InStrRev(Target, ".") - 1) & "_" & Format(Now, "yyyymmddhhmmss") & ".xls"
Set xlsheet = Nothing
xlBook.SaveAs (Target)
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub
ErrorHandling:
Call ErrorWriteBuff(Text1.Text, CLng(i), "WriteDataToExcel", Err.Number, Err.Description, "")
Resume Next
End Sub
Private Sub CellsWriteComment(Start1 As Integer, End1 As Integer, Start2 As Integer, End2 As Integer, Comment As String, SheetObject As EXCEL.Worksheet)
On Error GoTo ErrorHandling
With SheetObject
With .Range(.Cells(Start1, End1), .Cells(Start2, End2))
.Select
.AddComment
.Comment.Visible = False
.Comment.Text Text:=Comment
End With
End With
Exit Sub
ErrorHandling:
Call ErrorWriteBuff(Text1.Text, 0, "CellsWriteComment", Err.Number, Err.Description, "")
Resume Next
End Sub
Private Sub PictureBorder(Start1 As Integer, End1 As Integer, Start2 As Integer, End2 As Integer, SheetObject As EXCEL.Worksheet)
On Error GoTo ErrorHandling
With SheetObject
With .Range(.Cells(Start1, End1), .Cells(Start2, End2))
.Select
.Interior.Color = RGB(153, 204, 255)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End With
Exit Sub
ErrorHandling:
Call ErrorWriteBuff(Text1.Text, 0, "PictureBorder", Err.Number, Err.Description, "")
Resume Next
End Sub
[ 本帖最后由 wube 于 2011-9-14 11:12 编辑 ]
