为什么在vb中实现不了
本帖最后由 bcrun 于 2013-05-20 21:42:57 编辑
Private Sub ComboBoxNB_Change()
Dim mydata As String, mysql As String '调用数据库变时申明
Dim myDept, DepartNum, myText '调用数据库变时申明
If ComboBoxNB.Value = "默认" Then
'-----------------------------------------------------------------
ElseIf ComboBoxNB.Value = "智能计算公式" Then
'------------------------------------------[1]
On Error Resume Next '错误时运行下一步
MkDir ThisWorkbook.path & "/视窗文件/建筑" '新建文件
pwd = "123" '解压密码
rarfile = ThisWorkbook.path & "\znst\jsmm.rar" '压缩文件全路径
efile = "[9]智能图标库\[1]建筑图标库" '待解压文件
ToPath = ThisWorkbook.path & "\视窗文件\建筑" '解压目标路径
pID = Shell("c:\program files\winrar\rar.exe e -o+ -p" & pwd & " """ & rarfile & """ " & efile & " """ & ToPath & """", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pID)
Do
Call GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While ExitCode = STILL_ALIVE
Call CloseHandle(hProcess)
'------------------------------------------
'Dim mydata As String, mysql As String
'建立与职工信息数据库的连接
'Dim myDept, DepartNum, myText
mydata = ThisWorkbook.path & "\视窗文件\建筑\计算公式.mdb"
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open mydata
End With
'----为Treeview控件设置项目----
'设置一级节点(类别)
mysql = "select DISTINCT 类别 from 图形公式"
rs.Open mysql, cnn, adOpenKeyset, adLockOptimistic
myDept = rs.getrows
DepartNum = UBound(myDept, 2)
With TreeView2
.LineStyle = tvwRootLines
.Style = tvwTreelinesPlusMinusText
.LabelEdit = tvwManual
With .Nodes
.Clear
For I = 0 To DepartNum
.Add , , myDept(0, I), myDept(0, I)
'为一级节点设置二级节点
mysql = "select 编号,名称,宏名 from 图形公式 where 类别='" & myDept(0, I) & "' order by 编号"
If rs.State = 1 Then rs.Close
rs.Open mysql, cnn, adOpenKeyset, adLockOptimistic
For j = 1 To rs.RecordCount
myText = rs!编号 & " " & rs!名称 & " " & rs!宏名
.Add myDept(0, I), tvwChild, myDept(0, I) & I & j, myText
rs.MoveNext
Next j
Next I
End With
End With
'----为列表框ListView2控件设置项目----
'设置ListView2的标题、显示类型、整行选择和网格线属性
With ListView2
.ColumnHeaders.Clear
.ListItems.Clear
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
'mySql = "select 编号,名称,宏名,类别 from 图形公式 order by 编号"
'If rs.State = 1 Then rs.Close
'rs.Open mySql, cnn, adOpenKeyset, adLockOptimistic
'rs.MoveFirst
'设置ListView1的标题
With .ColumnHeaders
.Add , , "编号", 35
.Add , , "名称", 80, 2
.Add , , "宏名", 40, lvwColumnCenter
.Add , , "变量a", 40, 2 '居中显示
.Add , , "变量b", 40, 2
.Add , , "变量c", 40, 2
.Add , , "变量d", 40, 2
.Add , , "变量e", 40, 2
.Add , , "变量f", 40, 2
.Add , , "变量g", 40, 2
.Add , , "变量h", 40, 2
.Add , , "变量i", 40, 2
.Add , , "变量j", 40, 2
.Add , , "变量k", 40, 2
.Add , , "变量L", 40, 2
.Add , , "备注", 100, 2
End With
End With
'--------------为图片Imageb1控件设置项目---------------------------------
'Dim GIF As String, S As String, path As String
'path = ThisWorkbook.path & "\图形计算\程序\智能数据库\图标数据库"
' S = Dir(path & "\*.GIF")
' While Len(S) > 0
' S = Dir()
' Wend
' Imageb1.Picture = LoadPicture(ThisWorkbook.path & "" & "程序\智能数据库\图标数据库\1.GIF")
'GIF = Dir(ThisWorkbook.path & "\程序\智能数据库\图标数据库\*.GIF")
' ListBox1.AddItem "职工照片" '显示时不能选取,程序出错,以后在研究
' For N = 1 To N
' TreeView1.AddItem jpg
' GIF = Dir
' Next N
'显示第一个页面"按部门"
'MultiPage1.Value = 1
End If
备注.Text = "请您用鼠标点击启动两次,才能启动开程序"
End Sub
