Private Sub CmdList1_Click()
On Error GoTo Err
Dim pFilePath As String
With Me.CommonDialog1
.Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
.CancelError = True
.ShowOpen
pFilePath = CommonDialog1.FileName
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim xlApp As New Excel.Application, pTable As String
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.IgnoreRemoteRequests = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")
' For i = 1 To xlApp.Sheets.Count
pTable = xlApp.Sheets(1).Name
' Next
xlApp.Workbooks.Close
Set xlApp = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LabelWork1.Caption = "Excel工作薄名:" & pTable & "."
Dim strSQL As String
strSQL = "select * from [" & pTable & "$]"
Dim pSetLink As String
pSetLink = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pFilePath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
Adodc1.ConnectionString = pSetLink
Adodc1.RecordSource = strSQL
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
pColumns = DataGrid1.Columns.Count
For j = 0 To DataGrid1.Columns.Count - 1
' xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
ComboName.AddItem DataGrid1.Columns.Item(j).Caption, j
Next j
Err:
Select Case Err.Number
Case 32755
Case Else
Exit Sub
End Select
End Sub
Private Sub CmdList2_Click()
On Error GoTo Err
Dim pFilePath As String
With Me.CommonDialog2
.Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
.CancelError = True
.ShowOpen
pFilePath = CommonDialog2.FileName
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim xlApp As New Excel.Application, pTable As String
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.IgnoreRemoteRequests = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")
' For i = 1 To xlApp.Sheets.Count
pTable = xlApp.Sheets(1).Name
' Next
xlApp.Workbooks.Close
Set xlApp = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LabelWork2.Caption = "Excel工作薄名:" & pTable & "."
Dim strSQL As String
strSQL = "select * from [" & pTable & "$]"
Dim pSetLink As String
pSetLink = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pFilePath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
Adodc2.ConnectionString = pSetLink
Adodc2.RecordSource = strSQL
Adodc2.Refresh
Adodc1.Recordset.MoveFirst
Err:
Select Case Err.Number
Case 32755
Case Else
Exit Sub
End Select
End Sub
Private Sub CmdOutput_Click()
On Error GoTo FileErr
Dim pFilePath As String
With Me.CommonDialog3
.Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
.CancelError = True
.ShowOpen
pFilePath = CommonDialog3.FileName
End With
Me.MousePointer = 11 '变化鼠标,开始执行程序
Dim i As Long, j As Long
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.IgnoreRemoteRequests = False
xlApp.Visible = False '使EXCEL不可见
Set xlBook = xlApp.Workbooks.Add
Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")
Set xlSheet = xlBook.Worksheets(1)
For j = 0 To DataGrid1.Columns.Count - 1 '用于向EXCEL中添加字段名
xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
Next j
Call RunValue
'**************************************************************************************************************************************
'If Check1.Value = 1 Then
' Adodc1.Recordset!电脑单号 = Adodc2.Recordset!电脑单号
'elseif
' If pCheck1 = True Then
' Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value
' ElseIf pCheck2 = True Then
' Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value
' ElseIf pCheck3 = True Then
' Adodc1.Recordset.Fields("收货人姓名").Value = Adodc2.Recordset.Fields(收货人姓名).Value
' ElseIf pCheck4 = True Then
' Adodc1.Recordset.Fields("运输费").Value = Adodc2.Recordset.Fields(运输费).Value
' ElseIf pCheck5 = True Then
' Adodc1.Recordset.Fields("付款方式").Value = Adodc2.Recordset.Fields(付款方式).Value
' End If
'If (Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value) And (Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value) Then
'Dim db As String
'db = (Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value) And (Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value)
'If db Then
'
'End If
'Dim pTiaoJian As Boolean
'Select Case pTiaoJian
' Case pTiaoJian = True
' Debug.Print "输出语句"
' Case pTiaoJian = False
' Debug.Print "输出条件为假。"
'End Select
'ElseIf Adodc1.Recordset.Fields(pID).Value <> Adodc2.Recordset.Fields(pID).Value Then
'''''''''''''''''''''''''''''''''''''''''''''''''
'共计五个CHECK,组合?
'Dim k
'For k = 1 To pColumns
'
'Next k
''''''''''''''''''''''''''''''''''''''''''''''''
Adodc1.Recordset.MoveFirst
Adodc2.Recordset.MoveFirst
Dim dh1, dh2 As String, pID As Integer
pID = ComboName.ListIndex
For i = 0 To Adodc1.Recordset.RecordCount - 1 '向EXCEL中添加纵向数据,即计算列
If Adodc1.Recordset.Fields(pID).Value = Adodc2.Recordset.Fields(pID).Value Then
i = i - 1
ElseIf Adodc1.Recordset.Fields(pID).Value <> Adodc2.Recordset.Fields(pID).Value Then
DataGrid1.Row = i
For j = 0 To DataGrid1.Columns.Count - 1 '此处为循环,向EXCEL中添加横向数据,计算行
DataGrid1.Col = j
If IsNull(DataGrid1.Text) = False Then
xlSheet.Cells(i + 2, j + 1) = Trim(DataGrid1.Text)
End If
Next j
End If
Adodc1.Recordset.MoveNext
Adodc2.Recordset.MoveNext
Next i
'**************************************************************************************************************************************
xlApp.Rows("1:1").Select '选中第一行
xlApp.Selection.Font.Bold = True '设为粗体
xlApp.Selection.Font.Size = 9 '设置字体大小
'xlApp.Cells.EntireColumn.AutoFit '自动调整列宽
'xlApp.ActiveWindow.SplitRow = 1 '拆分第一行
'xlApp.ActiveWindow.SplitColumn = 0 '拆分列
'xlApp.ActiveWindow.FreezePanes = True '固定拆分 objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" '设置打印固定行
'xlApp.ActiveSheet.PageSetup.PrintTitleColumns = "" '打印标题 objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & Format(Now, "yyyy年mm月dd日 hh:MM:ss")
'xlApp.ActiveWindow.View = xlPageBreakPreview '设置显示方式
'xlApp.ActiveWindow.Zoom = 100 '设置显示大小
'xlApp.ActiveSheet.Weight = 2
Adodc1.Recordset.MoveLast
Adodc2.Recordset.MoveLast
Me.MousePointer = 1 '还原鼠标外观
FileErr:
Select Case Err.Number
Case 32755
Case Else
xlApp.DisplayAlerts = False '关闭时不提示保存
xlBook.Save
xlApp.Quit '关闭EXCEL
xlApp.DisplayAlerts = False '关闭时不提示保存
xlApp.Workbooks.Close
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Me.MousePointer = 1
End Select
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Call RunCheck
End Sub
Private Sub Form_Load()
On Error Resume Next
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Me.Caption = "数据对比分析器"
CmdOutput.Enabled = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RunCheck
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Form2 = Nothing
End Sub
Public Sub RunCheck()
If Check1.Value = 1 Or Check2.Value = 1 Or Check3.Value = 1 Or Check4.Value = 1 Or Check5.Value = 1 Then
CmdOutput.Enabled = True
Else
CmdOutput.Enabled = False
End If
End Sub
Public Sub RunValue()
Dim pLinkStr
'Select Case pTiaoJian
' Case pCheck1 = True
'
' Case pCheck1 = True
'' Debug.Print "输出条件为假。"
'End Select
End Sub