Criando Menu de Acesso com Controle de Visualização em Árvore

1. Campo de texto.
2. Campo numérico.
3. Campo de data/hora.
4. Campo de hiperlink.

1. Caixa de texto.
2. Botões de comando.
3. Caixa de combinação.
4. Caixa de listagem.

1. Caixa de texto.
2. Etiqueta.
3. Gráfico gráfico.

• O campo Formulário é para Nomes de formulários código de tipo de objeto 1,
• O campo de relatório contém nomes de relatório, código do tipo de objeto 2,
• Campo de macro é para nomes de macro, código do tipo de objeto 3.

Private Sub cmdOpen_Click()
Dim mn, mx, fltr As String
mn = Nz(Me![Min], 0)
mx = Nz(Me![Max], 9999)
If (mn + mx) > 0 Then
    fltr = "[List Price] > " & mn & " And " & "[List Price] <= " & mx
    DoCmd.OpenReport "Products Listing", acViewReport, , fltr, , fltr
Else
    DoCmd.OpenReport "Products Listing", acViewReport
End If

End Sub

Private Sub cmdCancel_Click()
DoCmd.Close
End Sub

Private Sub Report_Open(Cancel As Integer)
    DoCmd.Close acForm, "Parameter"
    Me.Range.Caption = Nz(Me.OpenArgs, "")
End Sub

1. 
   Crie um novo formulário, com o nome frmMenu, e adicione o Controle TreeView da Microsoft da Lista do Controle Activex. Redimensione o controle conforme mostrado na Visualização de Design abaixo:
   
2. 
   Altere o nome do Tree View Control para TreeView0 na Folha de Propriedades normal.
   
3. 
   Adicione um botão de comando abaixo do controle Tree View. Altere seu Nome Valor da propriedade para cmdExit e Legenda Valor da propriedade para Sair .
   
4. 
   Clique com o botão direito do mouse no controle de exibição em árvore e realce o TreeCtrl_Object opção e selecione Propriedades para exibir a folha de propriedades.
   
5. 
   Altere os seguintes valores de propriedade conforme indicado abaixo:
   

• Estilo =7 (tvwTreeLinesPlusMinusPictureText)
• Estilo de linha =1 (tvwRootLines)
• Editar etiqueta =1 (tvwManual)

With Me.TreeView0.Object
    .Style = tvwTreelinesPlusMinusPictureText
    .LineStyle = tvwRootLines	
    .LabelEdit = tvwManual
End With

Option Compare Database
Option Explicit

Dim tv As MSComctlLib.TreeView
Const KeyPrfx As String = "X"

Private Sub Form_Load()
Dim db As Database
Dim rst As Recordset
Dim nodKey As String
Dim PKey As String
Dim strText As String
Dim strSQL As String

Dim tmpNod As MSComctlLib.Node
Dim Typ As Variant

Set tv = Me.TreeView0.Object
tv.Nodes.Clear
‘Change the TreeView Control Properties
With tv
    .Style = tvwTreelinesPlusMinusPictureText
    .LineStyle = tvwRootLines
    .LabelEdit = tvwManual
    .Font.Name = "Verdana"
End With
strSQL = "SELECT ID, Desc, PID, Type,Macro,Form,Report FROM Menu;"

Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)

Do While Not rst.EOF And Not rst.BOF
    If Nz(rst!PID, "") = "" Then
        nodKey = KeyPrfx & CStr(rst!ID)
        strText = rst!Desc
      Set tmpNod = tv.Nodes.Add(, , nodKey, strText)
      
      'Root-Level Node Description in Bold letters
      With tmpNod
        .Bold = True
      End With
    Else
        PKey = KeyPrfx & CStr(rst!PID)
        nodKey = KeyPrfx & CStr(rst!ID)
        strText = rst!Desc
        Set tmpNod = tv.Nodes.Add(PKey, tvwChild, nodKey, strText)
     
     'Check for the presense of Type Code
        If Nz(rst!Type, 0) > 0 Then
            Typ = rst!Type
            Select Case Typ
                Case 1 'save type Code & Form Name in Node Tag Property
                    tmpNod.Tag = Typ & rst!Form
                Case 2 'save type Code & Report Name in Node Tag Property
                    tmpNod.Tag = Typ & rst!Report
                Case 3 'save type Code & Macro Name in Node Tag Property
                    tmpNod.Tag = Typ & rst!Macro
            End Select
        End If
        
    End If
    rst.MoveNext
Loop
rst.Close

Set rst = Nothing
Set db = Nothing

End Sub

Private Sub cmdExit_Click()
If MsgBox("Close Menu Form? ", vbYesNo, "cmdExit_Click()") = vbYes Then
    DoCmd.Close
End If
End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim varTag, typeid As Integer
Dim objName As String, nodOn as MSComctlLib.Node

If Node.Expanded = False Then
    Node.Expanded = True
Else
    Node.Expanded = False
End If
‘Reset the earlier lighlight to normal
For Each nodOn In tv.Nodes
    nodOn.BackColor = vbWhite
    nodOn.ForeColor = vbBlack
Next
‘changes BackColor to light Blue and ForeColor White
tv.Nodes.Item(Node.Key).BackColor = RGB(0, 143, 255)
tv.Nodes.Item(Node.Key).ForeColor = vbWhite
‘—Highlight code ends-
varTag = Nz(Node.Tag, "")
If Len(varTag) > 0 Then
    typeid = Val(varTag)
    objName = Mid(varTag, 2)
End If

Select Case typeid
    Case 1
        DoCmd.OpenForm objName, acNormal
    Case 2
        DoCmd.OpenReport objName, acViewPreview
    Case 3
        DoCmd.RunMacro objName
End Select
End Sub

With tv
    .Style = tvwTreelinesPlusMinusPictureText
    .LineStyle = tvwRootLines
    .LabelEdit = tvwManual
    .Font.Name = "Verdana"
End With 

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim varTag, typeid As Integer
Dim objName As String, nodOn as MSComctlLib.Node

If Node.Expanded = False Then
    Node.Expanded = True
Else
    Node.Expanded = False
End If 
‘Reset the earlier lighlight to normal
For Each nodOn In tv.Nodes
  nodOn.BackColor = vbWhite 
  nodOn.ForeColor = vbBlack
Next nodOn

‘changes BackColor to light Blue and ForeColor White
    tv.Nodes.Item(Node.Key).BackColor = RGB(0, 143, 255)
    tv.Nodes.Item(Node.Key).ForeColor = vbWhite
‘—Highlight code ends-

varTag = Nz(Node.Tag, "")
If Len(varTag) > 0 Then
    typeid = Val(varTag)
    objName = Mid(varTag, 2)
End If

Select Case typeid
    Case 1
        DoCmd.OpenForm objName, acNormal
    Case 2
        DoCmd.OpenReport objName, acViewPreview
    Case 3
        DoCmd.RunMacro objName
End Select
End Sub
 

If Node.Expanded = False Then
    Node.Expanded = True
Else
    Node.Expanded = False
End If 

‘Reset the earlier Highlight to Normal
For Each nodOn In tv.Nodes
  nodOn.BackColor = vbWhite 
  nodOn.ForeColor = vbBlack
Next nodOn
‘Changes BackColor to light Blue and ForeColor White
    tv.Nodes.Item(Node.Key).BackColor = RGB(0, 143, 255)
    tv.Nodes.Item(Node.Key).ForeColor = vbWhite
‘—Highlight code ends-

1. Adicione mais dois botões de comando na área superior do controle de exibição em árvore, conforme mostrado no design abaixo.
2. Alterar o Nome Valor da propriedade do botão de comando esquerdo para cmdExpand e a Legenda para Expandir tudo .
3. Da mesma forma, altere o Nome do botão de comando do lado direito Propriedade para cmdCollapse e a Legenda para Recolher tudo.
4. Copie e cole o seguinte código VBA abaixo do código existente no frmMenu Form e salve o formulário.

Private Sub cmdExpand_Click()
Dim Nodexp As MSComctlLib.Node

For Each Nodexp In tv.Nodes
    If Nodexp.Expanded = False Then
        Nodexp.Expanded = True
    End If
Next Nodexp
End Sub


Private Sub cmdCollapse_Click()
Dim Nodexp As MSComctlLib.Node

For Each Nodexp In tv.Nodes
    If Nodexp.Expanded = True Then
        Nodexp.Expanded = False
    End If
Next Nodexp
End Sub

MÓDULO DE CLASSE

1. Módulo de classe MS-Access e VBA
2. Objeto e matrizes de classe VBA do MS-Access
3. Classe base do MS-Access e objetos derivados
4. VBA-Base Class e Derived Object-2
5. Classe base e variantes de objetos derivados
6. Conjunto de registros e módulo de classe do MS-Access
7. Módulo de classe de acesso e classes wrapper
8. Funcionalidade da classe wrapper