Microsoft Office Forums - View Single Post - [Solved] Link UserForm checkbox to corresponding shape on one worksheet and copy to 'template' worksheet

Guessed · 10-02-2020, 05:13 AM

I didn't think you needed the Labels sheet. It serves no purpose in anything I did with the code. This is the code I would use for the requests you made above.

Code:

Option Explicit

Private Sub Innerenvelope_Click()
  Dim aSheet As Worksheet, aShape As Shape, aCtl As Control, sLabel As String
  Dim bLabel As Boolean
  
  Set aSheet = ActiveWorkbook.Sheets("ToFrom")
  bLabel = False
  
  For Each aCtl In Me.frameLabel.Controls
    If aCtl = True Then
      SetLabels sLabel:=aCtl.Tag, aSheet:=aSheet
      bLabel = True
    End If
  Next aCtl
  
  For Each aCtl In Me.frameMarking.Controls
    For Each aShape In aSheet.Shapes
      If aShape.Title = aCtl.Tag Then
        aShape.Visible = aCtl
      End If
      If aShape.Title = "Marking 1" Then
        If bLabel Then
          aShape.Top = 489
        Else
          aShape.Top = 440
        End If
      End If
    Next aShape
  Next aCtl
  
  For Each aShape In aSheet.Shapes
    If aShape.Title = "To Address" Then
      aShape.TextFrame2.TextRange.Text = Me.cbTo.Column(1)
    ElseIf aShape.Title = "From Address" Then
      aShape.TextFrame2.TextRange.Text = Me.cbFrom.Column(1)
    End If
  Next aShape
  
  Me.Hide

End Sub

Private Sub UserForm_Initialize()
  Dim aCell As Range, aLO As ListObject, x As Integer, aRange As Range
  
  Set aLO = ActiveWorkbook.Sheets("Inner envelope").ListObjects("tblAddress")
  Set aRange = aLO.DataBodyRange
  Me.cbTo.List = aRange.Value
  Me.cbFrom.List = aRange.Value
End Sub

Sub SetLabels(sLabel As String, aSheet As Worksheet)
  Dim aCtl As Control, lngColour As Long, aShape As Shape
  Select Case sLabel
    Case "Warning":  lngColour = RGB(120, 0, 0)
    Case "Caution":  lngColour = RGB(0, 120, 0)
    Case Else:       lngColour = RGB(0, 0, 120)
  End Select
  
  For Each aShape In aSheet.Shapes
    If aShape.Title = "Label" Then
      aShape.TextFrame2.TextRange.Text = sLabel
      aShape.Line.ForeColor.RGB = lngColour
    End If
  Next aShape
  
End Sub

I would also add and Unload command to the macro that calls the userform. This stops the form remembering your previous entry if you reshow the form during the session.

Code:

Private Sub Workbook_Open()
    Application.Visible = True
    UserForm1.Show
    Unload UserForm1
    Sheets("ToFrom").Activate
End Sub