VBATools

CC1 – Kontrolki osadzone w locie

Czasami mamy problemy, używając formantów z dodatkiem pakietów SP4 i SP6. Nigdy nie wiadomo, który z nich użytkownik ma zainstalowany. Niestety, nie są one zgodne w dół. Aby się zabezpieczyć, możemy stworzyć kontrolkę w locie, w trakcie wywołania kodu, za pomocą odwołań do nich. Oczywiście kontrolki te muszą być zarejestrowane w systemie użytkownika, ale mogą pochodzić z różnych pakietów.

Poniżej można zobaczyć przykład trzech kontrolek (TreeView, ListView i StatusBar). Wszystkie z bibliotek mscomctl.ocx

Aby pokazać różne możliwości wywoływania kod jest umieszczony w pustej formie, jak i w module który uruchamia tą formę.

Obrazek
'--------------------------------to module----------------------------------------------
Option Explicit

Public tvw As Object
Public ctl As Control
Public lvw As Control

Sub CreateControls()
'MVP OShon from VBATools.pl
With UserForm1
    'Create Treeview
    Set ctl = .Controls.Add("MSComctlLib.TreeCtrl.2", "TreeView1")
    With ctl
        .Left = 10
        .Top = 10
        .Height = 200
        .Width = 130
        .Visible = True
    End With
        Set tvw = ctl
    With tvw
        .CheckBoxes = True
        .LabelEdit = 1
        .LineStyle = 1
    
    'data to Treeview by tkuchta
    Dim i&, j&, strText$, xlWKS As Worksheet
    Set xlWKS = ActiveSheet
    On Error Resume Next
    Do
        i = i + 1
        Do
            j = j + 1
            strText = xlWKS.Cells(i, j)
            If Len(strText) > 0 Then
                If j = 1 Then
                    .Nodes.Add Key:=strText, _
                               Text:=strText
                Else
                    .Nodes.Add relative:=xlWKS.Cells(i, j - 1).Value, _
                               relationship:=tvwChild, _
                               Key:=strText, _
                               Text:=strText
                End If
            Else
                j = 0: Exit Do
            End If
        Loop
        If Len(xlWKS.Cells(i, 1)) = 0 Then Exit Do
    Loop
    On Error GoTo 0
    End With
    
    'Create Listview
    Set ctl = .Controls.Add("MSComctlLib.ListViewCtrl.2", "ListView1")
    With ctl
      .Left = 140
      .Top = 10
      .Height = 200
      .Width = 180
      .Visible = True
    End With
    
    Set lvw = ctl
    With lvw
      .ColumnHeaders.Add 1, , "Kolumna 1", 100
      .ColumnHeaders.Add 2, , "Kolumna 2", 50
      .Gridlines = True
      .View = 3
    
    'data to ListView
    Dim itmX As ListItem, x&
    For x = 1 To Cells(Rows.Count, "a").End(xlUp).Row
      Set itmX = .ListItems.Add(, , Cells(x, 1))
      itmX.SubItems(1) = Cells(x, 2)
    Next x
    End With
    
    .Show
End With
End Sub



'--------------------------------in forms----------------------------------------------
Option Explicit

Dim WithEvents StatusBar As MSComctlLib.StatusBar

Private Sub UserForm_Activate()
'MVP OShon from VBATools.pl
Dim sb_1 As Variant: sb_1 = Array(30, 198, 50, 50)
Dim sb_2 As Variant: sb_2 = Array(1, 2, 1, 1)
Dim sb_3 As Variant: sb_3 = Array("Zaznaczono komórek", _
                                  "Przykład zastosowania wybranej funkcji", _
                                  "Licencja", _
                                  "Rodzaj połączenia z bazą danych")
Dim i%
With StatusBar.Panels
    For i = 0 To UBound(sb_1)
        With .Item(i + 1)
            .MinWidth = sb_1(i)
            .Alignment = sb_2(i)
            .TooltipText = sb_3(i)
        End With
    Next i

    .Item(1) = Selection.Count
    .Item(2) = ActiveCell.Text
    .Item(3) = "Restrict"
    .Item(3).Enabled = False
    .Item(4) = "No Conn."
    .Item(4).Bevel = 2
    .Item(4).Enabled = False
End With
End Sub

Private Sub UserForm_Initialize()
    Set StatusBar = Me.Controls.Add("MSComctlLib.sbarctrl.2", "StatusBar")

    With StatusBar
        .Height = 18
        .Top = Me.Height - .Height - 21
        .Width = 324: Me.Width = .Width + 4
        With .Panels
            .Add 1: .Add 2: .Add 3
        End With
    End With
End Sub

Mam nadzieje że wam się spodoba. Napiszcie do czego wy go wykorzystujecie np z grupie dyskusyjnej FB.


Jeśli uważasz że pokazane materiały są godne polecenia – podziel się tą wiadomością z innymi pozostawiając odnośnik to tego materiału.

(c) Shon Oskar – http://VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.