ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 我的酷贴 > 综合应用 > TreeView數據庫完整範例

TreeView數據庫完整範例

作者：绿色风 分类： 时间：2022-08-18 浏览：132
楼主
allall		 UrserForm1的代碼：

  2. Option Explicit
  3. Private Sub Calendar1_Click()
  4.     Me.ComboBox3.Clear
  5.     Me.ComboBox3.AddItem Me.Calendar1.Value
  6.     Me.ComboBox3.ListIndex = 0
  7.     Me.Calendar1.Visible = False
  8.     If Me.ComboBox4.Value = "" Then Exit Sub
  9.     If CDate(Me.ComboBox4.Value) <= CDate(Me.ComboBox3.Value) Then
  10.         MsgBox "第二個日期必須大於第一個日期", vbInformation, "友情提示"
  11.         Me.ComboBox3.Clear
  12.         Exit Sub
  13.     End If
  14. End Sub
  15. Private Sub Calendar2_Click()
  16.     Me.ComboBox4.Clear
  17.     Me.ComboBox4.AddItem Me.Calendar2.Value
  18.     Me.ComboBox4.ListIndex = 0
  19.     Me.Calendar2.Visible = False
  20.     If Me.ComboBox3.Value = "" Then Exit Sub
  21.     If CDate(Me.ComboBox4.Value) <= CDate(Me.ComboBox3.Value) Then
  22.         MsgBox "第二個日期必須大於第一個日期", vbInformation, "友情提示"
  23.         Me.ComboBox4.Clear
  24.         Exit Sub
  25.     End If
  26. End Sub
  27. Private Sub CheckBox1_Click()
  28.     Dim r&, lvwCount&
  29.     Dim MyCol1 As New Collection
  30.     Dim MyCol2 As New Collection
  31.     Dim MyCol5 As New Collection
  32.     If Me.CheckBox1.Value = True Then
  33.         Me.CheckBox2.Value = False
  34.         Me.ComboBox1.Enabled = True
  35.         Me.ComboBox2.Enabled = True
  36.         Me.ComboBox5.Enabled = True
  37.         Me.Label2.Enabled = True
  38.         Me.Label4.Enabled = True
  39.         Me.Label13.Enabled = True
  40.         lvwCount = Me.ListView1.ListItems.Count
  41.         On Error Resume Next
  42.         For r = 1 To lvwCount
  43.             MyCol1.Add Me.ListView1.ListItems(r).SubItems(1), Me.ListView1.ListItems(r).SubItems(1)
  44.             MyCol2.Add Me.ListView1.ListItems(r).SubItems(2), Me.ListView1.ListItems(r).SubItems(2)
  45.             MyCol5.Add Me.ListView1.ListItems(r).SubItems(4), Me.ListView1.ListItems(r).SubItems(4)
  46.             Err.Clear
  47.         Next
  48.         For r = 1 To MyCol1.Count
  49.             Me.ComboBox1.AddItem MyCol1(r)
  50.         Next
  51.         For r = 1 To MyCol2.Count
  52.             Me.ComboBox2.AddItem MyCol2(r)
  53.         Next
  54.         For r = 1 To MyCol5.Count
  55.             Me.ComboBox5.AddItem MyCol5(r)
  56.         Next
  57.     Else
  58.         Me.ComboBox1.Clear
  59.         Me.ComboBox1.Enabled = False
  60.         Me.ComboBox2.Clear
  61.         Me.ComboBox2.Enabled = False
  62.         Me.ComboBox5.Clear
  63.         Me.ComboBox5.Enabled = False
  64.         Me.Label2.Enabled = False
  65.         Me.Label4.Enabled = False
  66.         Me.Label13.Enabled = False
  67.     End If
  68. End Sub
  69. Private Sub CheckBox2_Click()
  70.     If Me.CheckBox2.Value = True Then
  71.         Me.CheckBox1.Value = False
  72.         Me.ComboBox3.Enabled = True
  73.         Me.ComboBox4.Enabled = True
  74.         Me.Label1.Enabled = True
  75.         Me.Label3.Enabled = True
  76.     Else
  77.         Me.ComboBox3.Clear
  78.         Me.ComboBox3.Enabled = False
  79.         Me.ComboBox4.Clear
  80.         Me.ComboBox4.Enabled = False
  81.         Me.Label1.Enabled = False
  82.         Me.Label3.Enabled = False
  83.     End If
  84. End Sub
  85. Private Sub CommandButton2_Click()
  86.     Dim lvwArr
  87.     Dim r&, lvwCount&
  88.     Dim DateSet As Date, DateSet1 As Date, DateSet2 As Date
  89.     Dim txtFind1 As String, txtFind2 As String, txtFind5 As String
  90.     On Error GoTo Errhander
  91.     If Me.CheckBox2.Value = True Then
  92.         DateSet1 = CDate(Me.ComboBox3.Value)
  93.         DateSet2 = CDate(Me.ComboBox4.Value)
  94.         lvwCount = Me.ListView1.ListItems.Count
  95.         If lvwCount = 0 Then Exit Sub
  96.         'ReDim lvwArr(1 To lvwCount, 1 To 8)
  97.         For r = lvwCount To 1 Step -1
  98.             DateSet = CDate(Me.ListView1.ListItems(r).SubItems(5))
  99.             If DateSet < DateSet1 Then
  100.                 Me.ListView1.ListItems.Remove (r)
  101.             ElseIf DateSet > DateSet2 Then
  102.                 Me.ListView1.ListItems.Remove (r)
  103.             End If
  104.         Next
  105.     ElseIf Me.CheckBox1.Value = True Then
  106.         txtFind1 = Me.ComboBox1.Text
  107.         txtFind2 = Me.ComboBox2.Text
  108.         txtFind5 = Me.ComboBox5.Text
  109.         lvwCount = Me.ListView1.ListItems.Count
  110.         If lvwCount = 0 Then Exit Sub
  111.         For r = lvwCount To 1 Step -1
  112.             If txtFind1 = Me.ListView1.ListItems(r).SubItems(1) And _
  113.                txtFind2 = Me.ListView1.ListItems(r).SubItems(2) And _
  114.                txtFind5 = Me.ListView1.ListItems(r).SubItems(4) Then
  115.             Else
  116.                 Me.ListView1.ListItems.Remove (r)
  117.             End If
  118.         Next
  119.         lvwCount = Me.ListView1.ListItems.Count
  120.         If lvwCount = 0 Then MsgBox "未找到匹配記錄!", vbInformation, "友情提示"
  121.     End If
  122. Errhander:
  123.     If Me.CheckBox2.Value = True Then
  124.         MsgBox "未找到匹配記錄!" & Chr(13) & "請檢查輸入的日期範圍是否存在!", vbInformation, "友情提示"
  125.     End If
  126.     Err.Clear
  127. End Sub
  128. Private Sub Label5_Click()
  129.     Me.Calendar1.Visible = True
  130. End Sub
  131. Private Sub Label6_Click()
  132.     Me.Calendar2.Visible = True
  133. End Sub
  134. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  135.     Dim cnn As ADODB.Connection
  136.     Dim rst As ADODB.Recordset
  137.     Dim sql, i
  138.     Set cnn = New ADODB.Connection
  139.     Set rst = New ADODB.Recordset
  140.     On Error Resume Next
  141.     With cnn
  142.         .Provider = "Microsoft.Jet.OLEDB.4.0"
  143.         .ConnectionString = "Data source=" & ActiveWorkbook.FullName & ";Extended properties= Excel 8.0"
  144.         .CursorLocation = adUseClient
  145.         .Open
  146.     End With
  147.     Me.ListView1.ListItems.Clear
  148.     If Node.Children = 0 Then
  149.         sql = "select * from [材料表$] where 材料編號 like'" & Node.Text & "'"    '
  150.         rst.Open sql, cnn, adOpenKeyset
  151.         If rst.RecordCount = 0 Then MsgBox "未找到匹配記錄!", vbInformation, "友情提示": Exit Sub
  152.     Else
  153.         sql = "select * from [材料表$] where 材料編號 like'" & Node.Text & "%'"    '如某某字段內，包含“***”，則用 LIKE ‘%***%’，使用兩個百分號（%）
  154.         rst.Open sql, cnn, adOpenKeyset
  155.     End If
  156.     For i = 1 To rst.RecordCount
  157.         With Me.ListView1.ListItems.Add()
  158.             .Text = rst.Fields(0)
  159.             .SubItems(1) = rst.Fields(1)
  160.             .SubItems(2) = rst.Fields(2)
  161.             .SubItems(3) = rst.Fields(3)
  162.             .SubItems(4) = rst.Fields(4)
  163.             .SubItems(5) = rst.Fields(5)
  164.             .SubItems(6) = rst.Fields(6)
  165.             .SubItems(7) = rst.Fields(7)
  166.         End With
  167.         Err.Clear
  168.         rst.MoveNext
  169.     Next
  170.     Set cnn = Nothing
  171.     Set rst = Nothing
  172. End Sub
  173. Private Sub UserForm_Initialize()
  174.     Dim introw&, intcol&, i&, r&, n&
  175.     Dim str$, str1$
  176.     Dim tvwArr
  177.     On Error Resume Next
  178.     Me.TreeView1.Style = tvwTreelinesPlusMinusPictureText
  179.     Me.TreeView1.LineStyle = tvwRootLines
  180.     Me.TreeView1.CheckBoxes = False
  181.     Me.TreeView1.Nodes.Clear
  182.     Me.TreeView1.Nodes.Add , , "top", "產品名稱"
  183.     introw = Sheet1.UsedRange.Rows.Count
  184.     intcol = Sheet1.UsedRange.Columns.Count
  185.     tvwArr = Sheet1.UsedRange
  186.     For r = 1 To intcol
  187.         For i = 2 To introw
  188.             If Not IsEmpty(tvwArr(i, r)) Then
  189.                 If r = 1 Then
  190.                     Me.TreeView1.Nodes.Add "top", tvwChild, tvwArr(i, r), tvwArr(i, r)
  191.                 ElseIf Not IsEmpty(tvwArr(i, r - 1)) Then
  192.                     Me.TreeView1.Nodes.Add tvwArr(i, r - 1), tvwChild, tvwArr(i, r), tvwArr(i, r)
  193.                 Else
  194.                     Me.TreeView1.Nodes.Add CStr(Sheet1.Cells(i, r - 1).End(xlUp)), tvwChild, tvwArr(i, r), tvwArr(i, r)
  195.                 End If
  196.             End If
  197.         Next
  198.     Next
  199.     Me.ListView1.View = lvwReport
  200.     Me.ListView1.FullRowSelect = True
  201.     Me.ListView1.Gridlines = True
  202.     Me.ListView1.FlatScrollBar = False
  203.     Me.ListView1.ColumnHeaders.Clear
  204.     For i = 1 To 8
  205.         Me.ListView1.ColumnHeaders.Add , , Sheet3.Cells(1, i)
  206.     Next
  207.     Me.Calendar1.Visible = False
  208.     Me.Calendar2.Visible = False
  209.     Me.CheckBox1.Value = False
  210.     Me.CheckBox2.Value = True
  211.     Me.ComboBox1.Enabled = False
  212.     Me.ComboBox2.Enabled = False
  213.     Me.ComboBox5.Enabled = False
  214.     Me.Label2.Enabled = False
  215.     Me.Label4.Enabled = False
  216.     Me.Label13.Enabled = False
  217. End Sub


詳細請見附件Treeview.jpg
 

TreeView.rar
2楼
allall		 再加一個國外的範例
3楼
slad		 感谢
4楼
i彳亍		 多谢LZ无私分享！
5楼
i彳亍		 多谢无私分享
6楼
kangfeng		 333333333333333

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap