locked
Excel VBA to add multiple labels and textboxes to a activex Frame RRS feed

  • Question

  • Hi All,

    I have a below code to insert activex frame on excel sheet and add just 1 label to the frame.

    Sub addlabels()
    Dim rng As Range
    Dim CELL As Range
    'Dim Myframe As OLEObject
    Set LblSht = Sheet1
    
    For i = LblSht.OLEObjects.Count To 1 Step -1
    LblSht.OLEObjects(i).Delete
    Next i
    
    Set rng = LblSht.Range("B15")
    LblSht.OLEObjects.Add "FORMS.frame.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height
    
    Set Myframe = LblSht.OLEObjects("Frame1").Object
    
    Set Lbl = Myframe.Controls.Add("Forms.Label.1", "lbl1")
    Lbl.Caption = "Foo"
    
    
    End Sub


    I want to add 6 labels and 6 textboxes to the frame. Each label caption shall dynamially come from seperate sheet "Ref Sheet" range A1 to A6 and textboxes values from ref sheet range B1 to B6.

    Thanks,

    Zav

    • Edited by zaveri cc Wednesday, December 16, 2015 2:45 AM
    Wednesday, December 16, 2015 2:44 AM

Answers

  • Zav,

    below is a sample using the ControlPositioner class.

    Andreas.

    Sub Test()
      Dim rng As Range
      Dim WrkSht As Worksheet
      Dim O As OLEObject
      Dim i As Integer, j As Integer
      Dim F As MSForms.Frame
      Dim L As MSForms.Label
      Dim W As Single, H As Single
      Dim CP As New ControlPositioner
    
      Set WrkSht = ActiveSheet
      Set rng = WrkSht.Range("B17")
      With rng
        Set O = WrkSht.OLEObjects.Add("Forms.Frame.1", _
          Left:=.Left, _
          Top:=.Top, _
          Width:=.Width, _
          Height:=.Height)
        Set F = O.Object
        F.Caption = ""
        F.SpecialEffect = fmSpecialEffectFlat
        W = F.Width
        H = F.Height
        For i = 0 To 2
          For j = 0 To 1
            Set L = F.Controls.Add("Forms.Label.1")
            Select Case j + (i * 2)
              Case 0: L.Caption = "Andreas"
              Case 1: L.Caption = "Killer"
              Case 2: L.Caption = "Bugs"
              Case 3: L.Caption = "Bunny"
              Case 4: L.Caption = "Mickey"
              Case 5: L.Caption = "Mouse"
            End Select
            L.BorderStyle = fmBorderStyleSingle
            CP.Add L, j, i, True, True
          Next
        Next
        CP.MoveControls
        W = rng.Width / rng.ColumnWidth
        H = rng.Height / rng.RowHeight
        rng.ColumnWidth = CP.AreaWidth / W
        rng.RowHeight = CP.AreaHeight / H
        F.Width = CP.AreaWidth
        F.Height = CP.AreaHeight
      End With
    End Sub

    • Marked as answer by David_JunFeng Wednesday, December 23, 2015 9:20 AM
    Wednesday, December 16, 2015 4:14 PM

All replies

  • Hi All,

    Is there any way via vba code to add or insert multiple labels into a frame. I have below code to create frame.


    Sub addLabels()
    Dim rng As Range
    Dim CELL As Range
    Dim Myframe As OLEObject



    Set rng = LblSht.Range("B15")
    LblSht.OLEObjects.Add "FORMS.frame.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height

    Set Myframe = LblSht.OLEObjects("Frame1")


    End Sub

    Thanks,

    Zav



    Monday, December 14, 2015 7:57 PM
  • Hi All,

    I want to dynamically add 6 active x labels to a cell. label shall auto size itself and fit into a cell. cell location is B17. Below is the example of how cell B17 will look

    Label1                 Label4

    Label2                 Label5

    Label3                 Label6

    I use below code to insert label in a range (multiple cells)

    Dim rng As Range
    Dim ShtRng As Range
    Dim WrkSht As Worksheet
    
    Set ShtRng = Range("A17:F17")
    Set WrkSht = Application.ActiveSheet
    
    For Each rng In ShtRng
        WrkSht.OLEObjects.Add "FORMS.Label.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height
        
    Next

    Thanks,

    Zav

    • Merged by David_JunFeng Thursday, December 17, 2015 5:59 AM Duplicated
    Monday, December 14, 2015 8:43 PM
  • Hi Zav,

    >>Is there any way via vba code to add or insert multiple labels into a frame. I have below code to create frame.<<

    Yes. We can add controls to the frame control via the control collection. And here is an code sample for your reference:

    Sub addlabels()
    Dim rng As Range
    Dim CELL As Range
    'Dim Myframe As OLEObject
    Set LblSht = Sheet1
    
    For i = LblSht.OLEObjects.Count To 1 Step -1
    LblSht.OLEObjects(i).Delete
    Next i
    
    Set rng = LblSht.Range("B15")
    LblSht.OLEObjects.Add "FORMS.frame.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height
    
    Set Myframe = LblSht.OLEObjects("Frame1").Object
    
    Set Lbl = Myframe.Controls.Add("Forms.Label.1", "lbl1")
    Lbl.Caption = "Foo"
    
    
    End Sub

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Tuesday, December 15, 2015 5:16 AM
  • Sub Test()
      Dim rng As Range
      Dim WrkSht As Worksheet
      Dim O As OLEObject
      Dim i As Integer, j As Integer
    
      Set WrkSht = ActiveSheet
      Set rng = WrkSht.Range("B17")
      With rng
        For i = 0 To 2
          For j = 0 To 1
            Set O = WrkSht.OLEObjects.Add("Forms.Label.1", _
              Left:=.Left + .Width / 2 * j, _
              Top:=.Top + .Height / 3 * i, _
              Width:=.Width / 2, _
              Height:=.Height / 3)
          Next
        Next
      End With
    End Sub

    • Proposed as answer by David_JunFeng Wednesday, December 16, 2015 1:06 AM
    Tuesday, December 15, 2015 8:15 AM
  • Hi Fei,

    Thanks for the response. I want to add 6 labels and 6 text boxes into the frame. Also, each label (6) caption should dynamically come from a another sheet "Reference Sheet" range A1 to A6 and values for the text box shall come from reference sheet range "B1 to B6"

    I have below code which inserts 6 labels to a cell.

    Sub Test()
      Dim rng As Range
      Dim WrkSht As Worksheet
      Dim O As OLEObject
      Dim i As Integer, j As Integer
    
      Set WrkSht = ActiveSheet
      Set rng = WrkSht.Range("B17")
      With rng
        For i = 0 To 2
          For j = 0 To 1
            Set O = WrkSht.OLEObjects.Add("Forms.Label.1", _
              Left:=.Left + .Width / 2 * j, _
              Top:=.Top + .Height / 3 * i, _
              Width:=.Width / 2, _
              Height:=.Height / 3)
          Next
        Next
      End With
    End Sub

    Thanks,

    Zav


    • Edited by zaveri cc Wednesday, December 16, 2015 2:38 AM
    Wednesday, December 16, 2015 2:37 AM
  • Hi Andreas,

    Thanks for the code, it works great but have to increase the size of the cell manually. Code do not autofit the labels into the cell.

    I want to make slight change in the code. I want to add frame on the sheet with 6 labels and 6 textboxes. Each label caption shall come from seperate sheet "Ref sheet" range A1 to A6 and value for each textboxes shall come from ref sheet range B1 to B6.

    Also, cell B17 shall expand to autofit the frame, and labels and textboxes shall autofit into the frame.

    I have below code to add frame and 1 label to a frame.

    Sub addlabels()
    Dim rng As Range
    Dim CELL As Range
    'Dim Myframe As OLEObject
    Set LblSht = Sheet1
    
    For i = LblSht.OLEObjects.Count To 1 Step -1
    LblSht.OLEObjects(i).Delete
    Next i
    
    Set rng = LblSht.Range("B15")
    LblSht.OLEObjects.Add "FORMS.frame.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height
    
    Set Myframe = LblSht.OLEObjects("Frame1").Object
    
    Set Lbl = Myframe.Controls.Add("Forms.Label.1", "lbl1")
    Lbl.Caption = "Foo"
    
    
    End Sub

    Thanks,

    Zav


    • Edited by zaveri cc Wednesday, December 16, 2015 2:53 AM
    Wednesday, December 16, 2015 2:51 AM
  • Code do not autofit the labels into the cell.

    Also, cell B17 shall expand to autofit the frame, and labels and textboxes shall autofit into the frame.

    The code fit the labels to the cell, it depends on the size of the cell how large the labels becomes.

    Below is a sample to add the labels to a frame.

    When you want to have a "Autofit" feature, you have to fill the captions into the labels, set the AutoSize property of each label to True, determine the width and height of each label, calculate the min. row resp. column size, shrink the frame and move the labels to the appropriate position and finally resize the cell.

    As you can suspect from this brief description you have to write a extensive code to get it to work.

    Here is a class module for that, primary designed for Userforms, but should also work for your scenario.
    https://dl.dropboxusercontent.com/u/35239054/ControlPositioner.cls

    Andreas.

    Sub Test()
      Dim rng As Range
      Dim WrkSht As Worksheet
      Dim O As OLEObject
      Dim i As Integer, j As Integer
      Dim F As MSForms.Frame
      Dim L As MSForms.Label
      Dim W As Single, H As Single
    
      Set WrkSht = ActiveSheet
      Set rng = WrkSht.Range("B17")
      With rng
        Set O = WrkSht.OLEObjects.Add("Forms.Frame.1", _
          Left:=.Left, _
          Top:=.Top, _
          Width:=.Width, _
          Height:=.Height)
        Set F = O.Object
        F.Caption = ""
        F.SpecialEffect = fmSpecialEffectFlat
        W = F.Width
        H = F.Height
        For i = 0 To 2
          For j = 0 To 1
            Set L = F.Controls.Add("Forms.Label.1")
            L.Left = W / 2 * j
            L.Top = H / 3 * i
            L.Width = W / 2
            L.Height = H / 3
            L.Caption = "Foo"
            L.BorderStyle = fmBorderStyleSingle
          Next
        Next
      End With
    End Sub


    Wednesday, December 16, 2015 11:27 AM
  • Zav,

    below is a sample using the ControlPositioner class.

    Andreas.

    Sub Test()
      Dim rng As Range
      Dim WrkSht As Worksheet
      Dim O As OLEObject
      Dim i As Integer, j As Integer
      Dim F As MSForms.Frame
      Dim L As MSForms.Label
      Dim W As Single, H As Single
      Dim CP As New ControlPositioner
    
      Set WrkSht = ActiveSheet
      Set rng = WrkSht.Range("B17")
      With rng
        Set O = WrkSht.OLEObjects.Add("Forms.Frame.1", _
          Left:=.Left, _
          Top:=.Top, _
          Width:=.Width, _
          Height:=.Height)
        Set F = O.Object
        F.Caption = ""
        F.SpecialEffect = fmSpecialEffectFlat
        W = F.Width
        H = F.Height
        For i = 0 To 2
          For j = 0 To 1
            Set L = F.Controls.Add("Forms.Label.1")
            Select Case j + (i * 2)
              Case 0: L.Caption = "Andreas"
              Case 1: L.Caption = "Killer"
              Case 2: L.Caption = "Bugs"
              Case 3: L.Caption = "Bunny"
              Case 4: L.Caption = "Mickey"
              Case 5: L.Caption = "Mouse"
            End Select
            L.BorderStyle = fmBorderStyleSingle
            CP.Add L, j, i, True, True
          Next
        Next
        CP.MoveControls
        W = rng.Width / rng.ColumnWidth
        H = rng.Height / rng.RowHeight
        rng.ColumnWidth = CP.AreaWidth / W
        rng.RowHeight = CP.AreaHeight / H
        F.Width = CP.AreaWidth
        F.Height = CP.AreaHeight
      End With
    End Sub

    • Marked as answer by David_JunFeng Wednesday, December 23, 2015 9:20 AM
    Wednesday, December 16, 2015 4:14 PM