软件总结整理（1）

标签（空格分隔）： 程序猿

---

源代码

Private Sub Command1_Click()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim text1text As String
Dim text2text As String
Dim temp As String
Dim count As Integer
Dim count2 As Integer

Dim newxls As New excel.Application
Dim newbook As New excel.Workbook
Dim newsheet As New excel.Worksheet
Set newxls = CreateObject("Excel.Application")
Set newbook = newxls.Workbooks.Open("" & App.Path & "\金具统计.xlsx")  '创建工作簿
Set newsheet = newbook.Worksheets(1) '创建工作表
newsheet.Range("A1:IV65536").Clear

Dim aa() As Integer '单个图号，每个金具的数量，最后叠加成bb
Dim bb() As Integer '所有图号，每个金具的数量
Dim ee() As Integer '单个图号，每个金具的数量(未乘个数）
Dim cc() As String '与aa对应，表示相应金具的型号
Dim dd() As String '与aa对应，表示相应金具的名称
Dim temppp() As String
ReDim temppp(0 To DataCombo1.UBound)
    
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\jjk.mdb;Persist Security Info=False"
sql = "select * FROM jjk"
rs.Open sql, cn
count = rs.Fields.count
ReDim aa(count)
ReDim bb(count)
ReDim cc(count)
ReDim ee(count)
ReDim dd(count)
ReDim jj(count)
cn.Close
  
For i = 0 To DataCombo1.UBound  '所有复合框循环，实现累加
    temp = Trim(DataCombo1(i).Text)
    If temp <> "" Then
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\jjk.mdb;Persist Security Info=False"
        sql = "select * FROM jjk where sno='" & temp & "'"
        rs.Open sql, cn
        count = rs.Fields.count
            If rs.EOF <> True Then
                For ii = 2 To count - 1 '所有字段循环，计算每个金具的数量
                    aa(ii) = 0
                    aa(ii) = rs.Fields(ii) * Val(Text1(i).Text)
                    cc(ii) = rs(ii).Name
                    ee(ii) = rs.Fields(ii)
                        If ee(ii) <> 0 Then
                            temppp(i) = temppp(i) & cc(ii) & "=" & ee(ii) & vbCrLf
                        End If
                    bb(ii) = bb(ii) + aa(ii)
                Next ii
                If DataCombo1(i).Text <> "" Then
                    text2text = text2text & vbCrLf & "第" & i + 1 & "个串号：" & DataCombo1(i).Text & "  共计" & Text1(i) & "串，每串对应金具及数量如下：" & vbCrLf & temppp(i)
                End If
            Else
                newbook.Close (True)
                newxls.Quit
                Set newxls = Nothing
                MsgBox "第" & i + 1 & "串图号不存在，或者该串图号输入错误，请检查！"
                Exit Sub
            End If
            cn.Close
    End If
Next i
       
For ii = 2 To count - 1
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\jjk.mdb;Persist Security Info=False"
sql = "select [" & cc(ii) & "] FROM jjm"
rs.Open sql, cn
On Error Resume Next
    If rs.EOF <> True Then
        dd(ii) = rs(0)
    End If
cn.Close
Next ii
    
ss = 3
Text2.Text = ""
For h = 1 To count '循环所有字段，如果总数不等于0，就在excel中记录下来
    If bb(h) <> 0 Then
        newsheet.Cells(ss, 1) = ss - 2
        newsheet.Cells(ss, 2) = dd(h)
        newsheet.Cells(ss, 3) = cc(h)
        newsheet.Cells(ss, 4) = bb(h)
        text1text = text1text & dd(h) & "  " & cc(h) & "=" & bb(h) & vbCrLf
        ss = ss + 1
    End If
Next h

newsheet.Cells(1, 1) = "金具数量统计表"
newsheet.Cells(2, 1) = "序号"
newsheet.Cells(2, 2) = "金具名称"
newsheet.Cells(2, 3) = "金具型号"
newsheet.Cells(2, 4) = "金具数量"
newsheet.Cells(1, 1).Font.Bold = True
newsheet.Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).Merge
newsheet.Range(Cells(2, 2), Cells(100, 3)).Columns.EntireColumn.AutoFit
Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).HorizontalAlignment = xlCenter
Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).VerticalAlignment = xlCenter

Text2.Text = "金具统计报告" & vbCrLf & "金具统计情况如下：" & vbCrLf & text1text & vbCrLf & vbCrLf & "请仔细核对串号对应金具及数量是否正确!" & text2text

newbook.Close (True)
newxls.Quit
Set newxls = Nothing

End Sub

技巧总结

新建并引用EXCEL表

打开和关闭具体参见代码
打开之后记得关闭，先关闭文件，再关闭程序，再释放内存

redim的使用

Dim aa() As Integer
ReDim aa(count)

重新定义会刷新数组的值，如果原值不变则需要：

Redim Preserve MyArray(15)

数据集的操作

数据集的值：rs.fields(i)或者rs(i)或者rs("U-10")
数据集的字段名：rs(i).name
数据集的字段总数：rs.fields.count

几个SQL语句

sql = "select * FROM jjk where sno='" & temp & "'"
sql = "select [" & cc(ii) & "] FROM jjm"

On Error Resume Next的使用

jjk里面有个字段，但是jjm里面没有，在运行sql = "select [" & cc(ii) & "] FROM jjm"时出错，此时可以运用这个语句，忽略这个问题，不会对结果造成影响。

exit sub 的使用

要是运行到一半想退出，可运行这条语句

在EXCEL中的操作语言

• 写入excel

ss = 3
For h = 1 To count 
    If bb(h) <> 0 Then
        newsheet.Cells(ss, 1) = ss - 2
        newsheet.Cells(ss, 2) = dd(h)
        newsheet.Cells(ss, 3) = cc(h)
        newsheet.Cells(ss, 4) = bb(h)
        ss = ss + 1
    End If
Next h

• 合并、加粗、居中、自动变化大小等

newsheet.Cells(1, 1).Font.Bold = True
newsheet.Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).Merge
newsheet.Range(Cells(2, 2), Cells(100, 3)).Columns.EntireColumn.AutoFit
Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).HorizontalAlignment = xlCenter
Range(newsheet.Cells(1, 1), newsheet.Cells(1, 4)).VerticalAlignment = xlCenter

控件数组的个数

控件数组的个数：DataCombo1.UBound

Dim temppp() As String
ReDim temppp(0 To DataCombo1.UBound)