View Full Version : Solved: Color on userform
copyt
03-29-2012, 08:31 AM
Hello all, I was wondering if it's possible to show colors of cells on a userform.
Aussiebear
03-30-2012, 01:42 AM
Colour of cells or the colour of objects on the user form?
Kenneth Hobs
03-30-2012, 06:15 AM
Private Sub UserForm_Initialize()
Worksheets("Sheet1").Range("A1").Interior.Color = vbRed
Worksheets("Sheet1").Range("B1").Interior.Color = vbBlue
End Sub
Private Sub CommandButton1_Click()
UserForm1.BackColor = Worksheets("Sheet1").Range("A1").Interior.Color
End Sub
Private Sub CommandButton2_Click()
UserForm1.BackColor = Worksheets("Sheet1").Range("B1").Interior.Color
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
copyt
03-30-2012, 11:52 PM
Thank you for you responses and so sorry for my late reponse.
I need help for something like this,..
range A1 contains a certain data and yellow for interior-color, I would like to use listbox to display range A1 (data + color) on userform
Thanks,
mikerickson
03-31-2012, 08:34 AM
If you are showing one cell, a TextBox would be better than a list box.
All the items in a list box will have the same format (font size, font color, back color, etc.)
What code do you have so far for filling the control?
Also, how does A1 get its color. Detecting color that is the result of Conditional Formatting, is different than detecting the color set by the user.
Kenneth Hobs
03-31-2012, 07:58 PM
Private Sub UserForm_Initialize()
With ListBox1
.RowSource = "Sheet1!A1"
.BackColor = Worksheets("Sheet1").Range("A1").Interior.Color
End With
End Sub
copyt
04-01-2012, 12:16 AM
http://www.vbaexpress.com/forum/@%20mikerickson%20and%20Kenneth%20Hobs%20for%20your%20kind%20helps.%20I%20j ust%20knew%20that%20%22All%20the%20items%20in%20a%20list%20box%20will%20hav e%20the%20same%20format%20%28font%20size,%20font%20color,%20back%20color,%2 0etc.%29%22.%20What%20I%20wanted%20to%20do%20%28attached%29%20it%20might%20 be%20not%20possible.%20%20Thanks%20again,%20http://imageshack.us/f/837/41201290814am.jpg/14am.jpg/@ mikerickson (http://www.vbaexpress.com/forum/member.php?u=10706) and Kenneth Hobs (http://www.vbaexpress.com/forum/member.php?u=3661) for your kind helps.
I just knew that "All the items in a list box will have the same format (font size, font color, back color, etc.)". What I wanted to do (attached) might not be possible.
Thanks again,
http://img837.imageshack.us/img837/2777/41201290814am.jpg
http://www.vbaexpress.com/forum/@%20mikerickson%20and%20Kenneth%20Hobs%20for%20your%20kind%20helps.%20I%20j ust%20knew%20that%20%22All%20the%20items%20in%20a%20list%20box%20will%20hav e%20the%20same%20format%20%28font%20size,%20font%20color,%20back%20color,%2 0etc.%29%22.%20What%20I%20wanted%20to%20do%20%28attached%29%20it%20might%20 be%20not%20possible.%20%20Thanks%20again,%20http://imageshack.us/f/837/41201290814am.jpg/14am.jpg
mikerickson
04-01-2012, 12:43 AM
I understand that there is something called a SpreadSheet control that isn't available on my Mac that might do what you wanted.
If I had to do that, I'd use a bunch of text boxes.
mikerickson
04-01-2012, 02:19 AM
You make a code module, called clsLinkedTextBox, with this code.
' 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
And put this code in the userform.
' 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
copyt
04-01-2012, 03:09 AM
I am sorry. I am quite new for excel. Could you please give me an example file or explain a little more about the first part of the code (clsLinkedTextBox)? After I created a code module, called clsLinkedTextBox then showed the userform, an error occured.
http://img41.imageshack.us/img41/8285/412012120245pm.jpg
copyt
04-01-2012, 05:34 AM
@ mikerickson (http://www.vbaexpress.com/forum/member.php?u=10706)
Thank you very much. It's now working very nicely. I created a normal module intead of class module so that's why it did not work.
mikerickson
04-01-2012, 08:57 AM
I'm glad it helped.
I should mention that the reason for the class module is that if you want to have the created textboxes respond to events, the event code will go in the class module.
Note that the .Tag property of the created textbox is the address of its linked cell.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.