-
You make a code module, called clsLinkedTextBox, with this code.
[VBA]' in code module clsLinkedTextBox
Public WithEvents TextBox As MSForms.TextBox
Property Get LinkedCell() As Range
On Error Resume Next
Set LinkedCell = Range(TextBox.Tag)
On Error GoTo 0
End Property
Property Set LinkedCell(aCell As Range)
With TextBox
.Tag = aCell.Address(, , , True)
.AutoWordSelect = False
.BackColor = aCell.Interior.Color
.BorderColor = aCell.Borders.Color
If .BorderColor = 0 Then .BorderColor = 12566463
.BorderStyle = fmBorderStyleSingle
With .Font
.Bold = aCell.Font.Bold
.Italic = aCell.Font.Italic
.Name = aCell.Font.Name
.Size = aCell.Font.Size
.StrikeThrough = aCell.Font.StrikeThrough
.Underline = (aCell.Font.Underline <> xlUnderlineStyleNone)
End With
.ForeColor = aCell.Font.Color
.IntegralHeight = True
.MultiLine = aCell.WrapText
.SelectionMargin = False
.SpecialEffect = fmSpecialEffectFlat
Select Case aCell.HorizontalAlignment
Case xlGeneral
If TypeName(aCell.Value) = "Double" Then
.TextAlign = fmTextAlignRight
Else
.TextAlign = fmTextAlignLeft
End If
Case xlRight
.TextAlign = fmTextAlignRight
Case xlLeft
.TextAlign = fmTextAlignLeft
Case xlCenter
.TextAlign = fmTextAlignCenter
End Select
.Text = aCell.Text
End With
End Property[/VBA]
And put this code in the userform.
[VBA]' in userform code module
Private Sub CommandButton2_Click()
Call LayOutRange(Sheet1.Range("a1:b2"), 5, 5):Rem adjust
End Sub
Sub LayOutRange(dupRange As Range, ufLeft As Single, ufTop As Single)
Dim oneCell As Range, NewText As clsLinkedTextBox
Dim cellOffsetLeft As Single, cellOffsetTop As Single
Set NewTextBoxes = New Collection
cellOffsetLeft = dupRange.Left
cellOffsetTop = dupRange.Top
With UserForm1
For Each oneCell In dupRange
Set NewText = New clsLinkedTextBox
With NewText
Set .TextBox = Me.Controls.Add("Forms.TextBox.1")
With .TextBox
.Left = ufLeft + oneCell.Left
.Top = ufTop + oneCell.Top
.Height = oneCell.Height
.Width = oneCell.Width
End With
Set .LinkedCell = oneCell
End With
NewTextBoxes.Add Item:=NewText, Key:=oneCell.Address(, , , True)
Next oneCell
End With
End Sub[/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules