Profowo
10-19-2024, 06:03 PM
I am new in learning Userform VBA code, I designed the Userform with ClsTabMenu,Module1 and Usefrom Code but on clicking to load is diplaying
Run-time error "91"
Object Variable or With block variable not set
find attached excel and codes below
ClsTamenu coding
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
'ColorDestaq
Const ColorDestaq = 16730978
Public WithEvents mForm As MSForms.UserForm
Public WithEvents mPage As MSForms.MultiPage
Public WithEvents TabLabel As MSForms.Label
Public WithEvents TabIcon As MSForms.Label
Public WithEvents ActiveTab As MSForms.Label
Public WithEvents TabLine As MSForms.Label
Public LabelTop As Integer
Public LabelLeft As Long
Public LineLeft As Integer
Const IDC_HAND As Long = 32649
Sub MouseMoveIcon()
Dim hCursor As Long
hCursor = LoadCursor(0, ByVal IDC_HAND)
SetCursor hCursor
End Sub
Sub CreateTabMenu(form As MSForms.UserForm, muPage As MSForms.MultiPage)
Dim Ctrl As Control
Dim mPageName As String
Dim tempCol As New Collection
Dim IconCode As String
Set mForm = form
Set mPage = muPage
i = 1
'//Önce labellar kontrol edilir ve sýrasýna gore collactiona eklenir
'//First, the labels are checked and added to the collection in order.
head:
For Each Ctrl In mForm.Controls
TagValue = GetValue(Ctrl, 0)
mPageName = GetValue(Ctrl, 1)
If TagValue = "TabMenu" And mPageName = mPage.Name Then
If CInt(GetValue(Ctrl, 2)) = i Then
tempCol.Add Ctrl
i = i + 1
GoTo head:
End If
End If
Next
'//Form yüksekliðinden tabmenu eleman sayýsý ve aralarýndaki
'//boþluk kadar çýkarýp ikiye bölerek yukarýdan ve aþaðýdan eþit boþluk býrakýyoruz
'//Number of tabmenu elements from form height and between them
'//We remove as much as the space and divide it into two, leaving equal space from above and below.
LabelTop = (mForm.InsideHeight - ((tempCol.Count + tempCol.Count) * 20)) / 2
Index = 1
'//Yukarýda tempcol isimli Koleksiyona eklemiþ olduðumuz elemanlarýn dizaynýný yapýyoruz
'//We are designing the elements we have added to the Collection named tempcol above.
For i = 1 To tempCol.Count
Set Ctrl = tempCol(i)
LabelDesign Ctrl
LineLeft = Ctrl.Left + Ctrl.Width + 15
If GetValue(Ctrl, 2) = 1 Then
'//Eðer ctrl ilk Tablabel ise activeTab oluþturulur
'//If ctrl is the first Tablabel, activeTab is created
Set ActiveTab = mForm.Controls.Add("Forms.Label.1", "ActiveTab")
With ActiveTab
.Height = 40
.Width = 4
.BackColor = ColorDestaq
.BackStyle = fmBackStyleOpaque
.Top = LabelTop - 10
.Left = LineLeft - 1
End With
'//Ayný þekilde birinci elemana göre yan taraftaki çizgi ayarlanýr
'//In the same way, the line on the side is adjusted according to the first element.
Set TabLine = mForm.Controls.Add("Forms.Label.1", "TabLine")
With TabLine
.BackColor = RGB(212, 212, 212)
.Width = 1.4
.Left = LineLeft
.BackStyle = fmBackStyleOpaque
.ZOrder 1
End With
Ctrl.ForeColor = ColorDestaq
Ctrl.Font.Name = "Poppins"
Ctrl.Font.Bold = True
LabelLeft = Ctrl.Left
Else
End If
Ctrl.Left = LabelLeft
IconCode = tempCol(i).ControlTipText
'//Kontrolün ControlTiptex'i dolu ise icon oluþturulur
'//if the ControlTiptex of the control is full, the icon is created
If IconCode <> "" Then
Set TabIcon = mForm.Controls.Add("Forms.Label.1", "TabIcon" & tempCol(i))
With TabIcon
.Font.Name = "Segoe MDL2 Assets"
.Font.Size = 14
.ForeColor = RGB(51, 51, 51)
.BackStyle = fmBackStyleTransparent
.Caption = ChrW("&H" & tempCol(i).ControlTipText)
.Left = Ctrl.Left - 35
.Top = LabelTop
.ZOrder 1
End With
End If
LabelTop = LabelTop + Ctrl.Height + 20
Set tb = New ClsTabMenu
Set tb.TabLabel = Ctrl
Set tb.ActiveTab = ActiveTab
Set tb.mForm = mForm
Set tb.mPage = mPage
tbCol.Add tb
' Set TabLabel = Nothing
Next
With TabLine
.Height = LabelTop + 20
.Top = (mForm.InsideHeight - .Height) / 2
End With
'//Multipage stil ayarlarý yaparak her sayfaya transition effect ayarlýyoruz
'//We set the transition effect on each page by making multipage style settings
With mPage
.Style = fmTabStyleNone
.Top = 0
.Value = 0
.Left = TabLine.Left + 8
For i = 0 To .Pages.Count - 1
With .Pages(i)
.TransitionEffect = 7 '2 '3
.TransitionPeriod = 300
End With
Next i
End With
End Sub
Sub LabelDesign(Ctrl As MSForms.Label)
With Ctrl
.Font.Name = "Poppins"
.Font.Bold = True
.Font.Size = 11
.ForeColor = vbGrayText
.Top = LabelTop
.Width = 110
.Height = 20
.Left = .Left + 25
.Caption = WorksheetFunction.Proper(.Caption)
.BackStyle = fmBackStyleTransparent
' .BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignLeft
End With
End Sub
Function GetValue(Ctrl As Control, cIndex As Integer)
On Error Resume Next
GetValue = Split(Ctrl.Tag, "-")(cIndex)
End Function
Private Sub TabLabel_Click()
Dim mPageName As String
Dim iTag As Integer
Dim speed As Integer
On Error GoTo err:
'//Label'ýn sýrasý alýnýr
'//Label's order is taken
iTag = GetValue(TabLabel, 2) - 1
'//Hangi multipage için çalýþacaðý alýnýr
mPageName = GetValue(TabLabel, 1)
'//Once tum TabLabellar standart hale getirilir
'//For which multipage it will work
TabLabelOut TabLabel
'//aktif olan label iþaretlenir
'//the active label is marked
With TabLabel
.ForeColor = ColorDestaq
.Font.Name = "Poppins"
.Font.Bold = True
End With
If TabLabel = "Logout" Then Unload mForm
'//Multipage'in þu anki deðeri ile atanacak deðeri arasýndaki fark alýnýr ve hýz ayarlanýr
'//The difference between the current value of Multipage and the value to be assigned is taken and the speed is adjusted
speed = Abs(iTag - mForm.Controls(mPageName).Value)
With ActiveTab
Do While .Top < TabLabel.Top - 10
DoEvents
.Top = .Top + (0.05 * speed)
Loop
Do While .Top > TabLabel.Top - 10
DoEvents
.Top = .Top - (0.05 * speed)
Loop
End With
'//Multipage value atanýr
'//Multipage value is assigned
mForm.Controls(mPageName).Value = iTag
err:
If err.Number = 380 Then
MsgBox "You need To add a New page"
End If
End Sub
Sub TabLabelOut(Ctrl As MSForms.Label)
Dim mPageName As String
'//Formdaki diðer labellarý etkilememesi için sadece MultiPage ismi alýnýr
'//Only MultiPage name is taken so that it does not affect other labels in the form.
mPageName = GetValue(Ctrl, 1)
Dim ctr As Control
For Each ctr In mForm.Controls
If TypeName(Ctrl) = "Label" Then
'//eðer tag'i Multipage name içerirse, standart hale getirilir
'//if tag contains Multipage name, it is standardized
If InStr(1, ctr.Tag, mPageName) <> 0 Then
ctr.ForeColor = vbGrayText
ctr.Font.Name = "Poppins"
ctr.Font.Bold = True
End If
End If
Next
End Sub
Private Sub TabLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MouseMoveIcon
End Sub
Userform1 Coding
Private Sub UserForm_Initialize()
' Ensure the class instance tb is initialized
Set tb = New ClsTabMenu
' Ensure MultiPage1 exists before calling CreateTabMenu
If Not MultiPage1 Is Nothing Then
tb.CreateTabMenu Me, MultiPage1
Else
MsgBox "MultiPage1 could not be found."
End If
End Sub
Module1 coding
Public tb As New ClsTabMenu
Public tbCol As New Collection
Run-time error "91"
Object Variable or With block variable not set
find attached excel and codes below
ClsTamenu coding
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
'ColorDestaq
Const ColorDestaq = 16730978
Public WithEvents mForm As MSForms.UserForm
Public WithEvents mPage As MSForms.MultiPage
Public WithEvents TabLabel As MSForms.Label
Public WithEvents TabIcon As MSForms.Label
Public WithEvents ActiveTab As MSForms.Label
Public WithEvents TabLine As MSForms.Label
Public LabelTop As Integer
Public LabelLeft As Long
Public LineLeft As Integer
Const IDC_HAND As Long = 32649
Sub MouseMoveIcon()
Dim hCursor As Long
hCursor = LoadCursor(0, ByVal IDC_HAND)
SetCursor hCursor
End Sub
Sub CreateTabMenu(form As MSForms.UserForm, muPage As MSForms.MultiPage)
Dim Ctrl As Control
Dim mPageName As String
Dim tempCol As New Collection
Dim IconCode As String
Set mForm = form
Set mPage = muPage
i = 1
'//Önce labellar kontrol edilir ve sýrasýna gore collactiona eklenir
'//First, the labels are checked and added to the collection in order.
head:
For Each Ctrl In mForm.Controls
TagValue = GetValue(Ctrl, 0)
mPageName = GetValue(Ctrl, 1)
If TagValue = "TabMenu" And mPageName = mPage.Name Then
If CInt(GetValue(Ctrl, 2)) = i Then
tempCol.Add Ctrl
i = i + 1
GoTo head:
End If
End If
Next
'//Form yüksekliðinden tabmenu eleman sayýsý ve aralarýndaki
'//boþluk kadar çýkarýp ikiye bölerek yukarýdan ve aþaðýdan eþit boþluk býrakýyoruz
'//Number of tabmenu elements from form height and between them
'//We remove as much as the space and divide it into two, leaving equal space from above and below.
LabelTop = (mForm.InsideHeight - ((tempCol.Count + tempCol.Count) * 20)) / 2
Index = 1
'//Yukarýda tempcol isimli Koleksiyona eklemiþ olduðumuz elemanlarýn dizaynýný yapýyoruz
'//We are designing the elements we have added to the Collection named tempcol above.
For i = 1 To tempCol.Count
Set Ctrl = tempCol(i)
LabelDesign Ctrl
LineLeft = Ctrl.Left + Ctrl.Width + 15
If GetValue(Ctrl, 2) = 1 Then
'//Eðer ctrl ilk Tablabel ise activeTab oluþturulur
'//If ctrl is the first Tablabel, activeTab is created
Set ActiveTab = mForm.Controls.Add("Forms.Label.1", "ActiveTab")
With ActiveTab
.Height = 40
.Width = 4
.BackColor = ColorDestaq
.BackStyle = fmBackStyleOpaque
.Top = LabelTop - 10
.Left = LineLeft - 1
End With
'//Ayný þekilde birinci elemana göre yan taraftaki çizgi ayarlanýr
'//In the same way, the line on the side is adjusted according to the first element.
Set TabLine = mForm.Controls.Add("Forms.Label.1", "TabLine")
With TabLine
.BackColor = RGB(212, 212, 212)
.Width = 1.4
.Left = LineLeft
.BackStyle = fmBackStyleOpaque
.ZOrder 1
End With
Ctrl.ForeColor = ColorDestaq
Ctrl.Font.Name = "Poppins"
Ctrl.Font.Bold = True
LabelLeft = Ctrl.Left
Else
End If
Ctrl.Left = LabelLeft
IconCode = tempCol(i).ControlTipText
'//Kontrolün ControlTiptex'i dolu ise icon oluþturulur
'//if the ControlTiptex of the control is full, the icon is created
If IconCode <> "" Then
Set TabIcon = mForm.Controls.Add("Forms.Label.1", "TabIcon" & tempCol(i))
With TabIcon
.Font.Name = "Segoe MDL2 Assets"
.Font.Size = 14
.ForeColor = RGB(51, 51, 51)
.BackStyle = fmBackStyleTransparent
.Caption = ChrW("&H" & tempCol(i).ControlTipText)
.Left = Ctrl.Left - 35
.Top = LabelTop
.ZOrder 1
End With
End If
LabelTop = LabelTop + Ctrl.Height + 20
Set tb = New ClsTabMenu
Set tb.TabLabel = Ctrl
Set tb.ActiveTab = ActiveTab
Set tb.mForm = mForm
Set tb.mPage = mPage
tbCol.Add tb
' Set TabLabel = Nothing
Next
With TabLine
.Height = LabelTop + 20
.Top = (mForm.InsideHeight - .Height) / 2
End With
'//Multipage stil ayarlarý yaparak her sayfaya transition effect ayarlýyoruz
'//We set the transition effect on each page by making multipage style settings
With mPage
.Style = fmTabStyleNone
.Top = 0
.Value = 0
.Left = TabLine.Left + 8
For i = 0 To .Pages.Count - 1
With .Pages(i)
.TransitionEffect = 7 '2 '3
.TransitionPeriod = 300
End With
Next i
End With
End Sub
Sub LabelDesign(Ctrl As MSForms.Label)
With Ctrl
.Font.Name = "Poppins"
.Font.Bold = True
.Font.Size = 11
.ForeColor = vbGrayText
.Top = LabelTop
.Width = 110
.Height = 20
.Left = .Left + 25
.Caption = WorksheetFunction.Proper(.Caption)
.BackStyle = fmBackStyleTransparent
' .BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignLeft
End With
End Sub
Function GetValue(Ctrl As Control, cIndex As Integer)
On Error Resume Next
GetValue = Split(Ctrl.Tag, "-")(cIndex)
End Function
Private Sub TabLabel_Click()
Dim mPageName As String
Dim iTag As Integer
Dim speed As Integer
On Error GoTo err:
'//Label'ýn sýrasý alýnýr
'//Label's order is taken
iTag = GetValue(TabLabel, 2) - 1
'//Hangi multipage için çalýþacaðý alýnýr
mPageName = GetValue(TabLabel, 1)
'//Once tum TabLabellar standart hale getirilir
'//For which multipage it will work
TabLabelOut TabLabel
'//aktif olan label iþaretlenir
'//the active label is marked
With TabLabel
.ForeColor = ColorDestaq
.Font.Name = "Poppins"
.Font.Bold = True
End With
If TabLabel = "Logout" Then Unload mForm
'//Multipage'in þu anki deðeri ile atanacak deðeri arasýndaki fark alýnýr ve hýz ayarlanýr
'//The difference between the current value of Multipage and the value to be assigned is taken and the speed is adjusted
speed = Abs(iTag - mForm.Controls(mPageName).Value)
With ActiveTab
Do While .Top < TabLabel.Top - 10
DoEvents
.Top = .Top + (0.05 * speed)
Loop
Do While .Top > TabLabel.Top - 10
DoEvents
.Top = .Top - (0.05 * speed)
Loop
End With
'//Multipage value atanýr
'//Multipage value is assigned
mForm.Controls(mPageName).Value = iTag
err:
If err.Number = 380 Then
MsgBox "You need To add a New page"
End If
End Sub
Sub TabLabelOut(Ctrl As MSForms.Label)
Dim mPageName As String
'//Formdaki diðer labellarý etkilememesi için sadece MultiPage ismi alýnýr
'//Only MultiPage name is taken so that it does not affect other labels in the form.
mPageName = GetValue(Ctrl, 1)
Dim ctr As Control
For Each ctr In mForm.Controls
If TypeName(Ctrl) = "Label" Then
'//eðer tag'i Multipage name içerirse, standart hale getirilir
'//if tag contains Multipage name, it is standardized
If InStr(1, ctr.Tag, mPageName) <> 0 Then
ctr.ForeColor = vbGrayText
ctr.Font.Name = "Poppins"
ctr.Font.Bold = True
End If
End If
Next
End Sub
Private Sub TabLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MouseMoveIcon
End Sub
Userform1 Coding
Private Sub UserForm_Initialize()
' Ensure the class instance tb is initialized
Set tb = New ClsTabMenu
' Ensure MultiPage1 exists before calling CreateTabMenu
If Not MultiPage1 Is Nothing Then
tb.CreateTabMenu Me, MultiPage1
Else
MsgBox "MultiPage1 could not be found."
End If
End Sub
Module1 coding
Public tb As New ClsTabMenu
Public tbCol As New Collection