Jacob Hilderbrand
01-22-2009, 12:14 AM
I am having an issue and I am not sure what the problem is.
I have a class module (ClassTextBoxes) with the following:
Option Explicit
Public WithEvents TextBoxGroup As MSForms.TextBox
Private Sub TextBoxGroup_MouseDown(ByVal Button As Integer, ByVal
Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "Ok"
End Sub
And a Module with:
Option Explicit
Dim TextBoxes() As New ClassTextBoxes
Sub AddTextBox()
Dim Top As Double
Dim Left As Double
Dim Cel As Range
Dim Obj As OLEObject
Dim ObjTextBox As OLEObject
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Left = Range("B1").Left
Top = Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, After:=Range("A1")).Offset(1, 0).Top
For Each Obj In ActiveSheet.OLEObjects
If Obj.Name = "TextBox1" Then
Left = Obj.Left
End If
If Obj.BottomRightCell.Offset(1, 0).Top > Top Then
Top = Obj.BottomRightCell.Offset(1, 0).Top
End If
Next
Set ObjTextBox = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Top:=Top, Left:=Left, Height:=175, Width:=464.25)
ObjTextBox.Object.BorderStyle = 1
ObjTextBox.Object.MultiLine = True
Call InitializeClass
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Cel = Nothing
Set Obj = Nothing
Set ObjTextBox = Nothing
End Sub
Sub InitializeClass()
Dim i As Long
Dim j As Long
Dim n As Long
Dim ObjTextBox As OLEObject
For Each ObjTextBox In Sheets("Sheet1").OLEObjects
If ObjTextBox.progID = "Forms.TextBox.1" Then
If ObjTextBox.Object.MultiLine = True Then
j = j + 1
ReDim Preserve TextBoxes(1 To j)
Set TextBoxes(j).TextBoxGroup = ObjTextBox.Object
End If
End If
Next
Set ObjTextBox = Nothing
End Sub
The first sub adds a text box. The second sub creates a class of all the textboxes on the sheet. I want to run code whenever the textbox is clicked so I use the mousedown event.
Both subs work fine on their own, problem is when I add a textbox I call the initializeclass macro to reinitialize the class and add all the textboxes to a new class and it doesnt work.
Refer to the attached file.
You can click the add textbox button to add a new textbox and click the textbox and nothing will happen. Then click the initialize class button and reclick the textbox and you will get the message box.
Thanks
I have a class module (ClassTextBoxes) with the following:
Option Explicit
Public WithEvents TextBoxGroup As MSForms.TextBox
Private Sub TextBoxGroup_MouseDown(ByVal Button As Integer, ByVal
Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "Ok"
End Sub
And a Module with:
Option Explicit
Dim TextBoxes() As New ClassTextBoxes
Sub AddTextBox()
Dim Top As Double
Dim Left As Double
Dim Cel As Range
Dim Obj As OLEObject
Dim ObjTextBox As OLEObject
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Left = Range("B1").Left
Top = Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, After:=Range("A1")).Offset(1, 0).Top
For Each Obj In ActiveSheet.OLEObjects
If Obj.Name = "TextBox1" Then
Left = Obj.Left
End If
If Obj.BottomRightCell.Offset(1, 0).Top > Top Then
Top = Obj.BottomRightCell.Offset(1, 0).Top
End If
Next
Set ObjTextBox = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Top:=Top, Left:=Left, Height:=175, Width:=464.25)
ObjTextBox.Object.BorderStyle = 1
ObjTextBox.Object.MultiLine = True
Call InitializeClass
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Cel = Nothing
Set Obj = Nothing
Set ObjTextBox = Nothing
End Sub
Sub InitializeClass()
Dim i As Long
Dim j As Long
Dim n As Long
Dim ObjTextBox As OLEObject
For Each ObjTextBox In Sheets("Sheet1").OLEObjects
If ObjTextBox.progID = "Forms.TextBox.1" Then
If ObjTextBox.Object.MultiLine = True Then
j = j + 1
ReDim Preserve TextBoxes(1 To j)
Set TextBoxes(j).TextBoxGroup = ObjTextBox.Object
End If
End If
Next
Set ObjTextBox = Nothing
End Sub
The first sub adds a text box. The second sub creates a class of all the textboxes on the sheet. I want to run code whenever the textbox is clicked so I use the mousedown event.
Both subs work fine on their own, problem is when I add a textbox I call the initializeclass macro to reinitialize the class and add all the textboxes to a new class and it doesnt work.
Refer to the attached file.
You can click the add textbox button to add a new textbox and click the textbox and nothing will happen. Then click the initialize class button and reclick the textbox and you will get the message box.
Thanks