Trap a caption 1

[olekr]

Hi! In a form, I have different type of captions (labels, buttons, checkboks, etc.). I want to CTRL+click a control, and get the caption to the control in a textbox. Is this possible? (The reason are for translation of captions. So when the caption is in a textbox, I have a function to write the caption into a textfile. But thats no problem.) Thanx! Ole

 

[Andrzejek]

I don't know about CTRL+click, but would the Right-Click work for you?

Private Sub Label1_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)

If Button = 2 Then
    MsgBox Label1.Caption
End If

End Sub

Have fun.

---- Andy

 

[gmmastros]

For CTRL-Click...

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Shift = vbCtrlMask Then
        Text1.Text = Label1.Caption
    End If
    
End Sub

You can even double up the key combinations. To do a CTRL-ALT-CLICK....

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Shift = (vbCtrlMask Or vbAltMask) Then
        Text1.Text = Label1.Caption
    End If
    
End Sub

-George
Microsoft SQL Server MVP
My Blogs
SQLCop
"The great things about standards is that there are so many to choose from." - Fortune Cookie Wisdom

 

[olekr]

Hi! Perfect! This work like a charm:
If Shift = (vbCtrlMask Or vbAltMask) Then..

But if it is 50 controls in a form, must each control have an event, or can this be done more easy with subclassing or something?

 

[gmmastros]

You may want to do a little research on control arrays. This may not be the best solution for your particular situation, but I suspect it is.

-George
Microsoft SQL Server MVP
My Blogs
SQLCop
"The great things about standards is that there are so many to choose from." - Fortune Cookie Wisdom

 

[MajP]

I cannot think of an easy solution for this one.

But this will work for all listed controls that have caption except for a toggle or option button. For some unexplained reason only these two do not expose their events.

Paste this code on your form/s:

Private Sub UserForm_Activate()
   'textBoxOutput is the textbox to send the caption information
   'Change if necessary
   Dim ctrl As MSForms.Control
   For Each ctrl In Me.Controls
     Call mylabels.Add(ctrl, Me.TextBoxOutPut)
   Next ctrl
end sub

build two class modules

LabelName

Option Explicit

Private WithEvents mLabel As MSForms.Label
Private WithEvents mOptionButton As MSForms.OptionButton
Private WithEvents mFrame As MSForms.Frame
Private WithEvents mCheckbox As MSForms.CheckBox
Private WithEvents mToggleButton As MSForms.ToggleButton
Private WithEvents mCommandButton As MSForms.CommandButton
Private mControl As MSForms.Control
Private mTextBoxOut As MSForms.TextBox

Public Property Set Label(ByVal theLabel As MSForms.Control)
    On Error GoTo errLabel:
    Set mControl = theLabel
    If TypeOf theLabel Is MSForms.Label Then
      Set mLabel = theLabel
    ElseIf TypeOf theLabel Is MSForms.CheckBox Then
      Set mCheckbox = theLabel
    ElseIf TypeOf theLabel Is MSForms.ToggleButton Then
      Set mToggleButton = theLabel
    ElseIf TypeOf theLabel Is MSForms.Frame Then
      Set mFrame = theLabel
    ElseIf TypeOf theLabel Is MSForms.OptionButton Then
      Set mOptionButton = theLabel
    ElseIf TypeOf theLabel Is MSForms.CommandButton Then
      Set mCommandButton = theLabel
    End If
    Exit Property
errLabel:
    If Err.Number = 459 Then
      'For some reasons toggles and option buttons expose no events
      Debug.Print theLabel.Name
      Resume Next
    Else
      MsgBox Err.Number & "  " & Err.Description
    End If
End Property
Public Property Get Control()
  Set Control = mControl
End Property
Private Sub mCheckbox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 If Shift = 2 Then
    FillTextBox
  End If
End Sub
Private Sub mCommandButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Shift = 2 Then
    FillTextBox
  End If
End Sub
Private Sub mFrame_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Shift = 2 Then
    FillTextBox
  End If
End Sub
Private Sub mLabel_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Shift = 2 Then
    FillTextBox
  End If
End Sub
Public Property Set TextBoxOut(ByVal theTextBox As MSForms.TextBox)
   Set mTextBoxOut = theTextBox
End Property
Public Sub FillTextBox()
   If Not mTextBoxOut Is Nothing Then
      mTextBoxOut = mControl.Caption
      MsgBox "Mouse UP Event"
    Else
     MsgBox "Must set an output textbox"
   End If
End Sub
Private Sub mOptionButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Shift = 2 Then
    FillTextBox
  End If
End Sub
Private Sub mToggleButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Shift = 2 Then
    FillTextBox
  End If
End Sub

and
LabelNames

Option Explicit

Private mLabelNames As New Collection

' Add a lableName object to the collection.
Public Sub Add(theLabel As MSForms.Control, TextBoxOut As MSForms.TextBox, Optional ByVal key As Variant)
   Dim mLabel As LabelName
   If ValidLabel(theLabel) Then
      Set mLabel = New LabelName
      Set mLabel.Label = theLabel
      Set mLabel.TextBoxOut = TextBoxOut
     If IsMissing(key) Then
         mLabelNames.Add mLabel
     Else
         mLabelNames.Add mLabel, key
     End If
   End If
End Sub

Public Function Count() As Long
    Count = mLabelNames.Count
End Function

Public Sub Remove(ByVal Index As Variant)
    mLabelNames.Remove Index
End Sub

Public Function Item(ByVal Index As Variant) As LabelName
    Set Item = mLabelNames(Index)
End Function
Private Function ValidLabel(theLabel As MSForms.Control) As Boolean
  If TypeOf theLabel Is MSForms.Label _
    Or TypeOf theLabel Is MSForms.CheckBox _
    Or TypeOf theLabel Is MSForms.ToggleButton _
    Or TypeOf theLabel Is MSForms.Frame _
    Or TypeOf theLabel Is MSForms.CommandButton _
    Or TypeOf theLabel Is MSForms.OptionButton Then
      ValidLabel = True
  End If
End Function

Unfortunately unless someone knows a workaround you will have to do individual events for option buttons and toggles.

 

[MajP]

BTW. I did that in vba because I forgot which forum I was in. The implementation should be the same though.