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ę.
'--------------------------------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.