View Full Version : [SLEEPER:] Creating Logo Via Userform Input

07-07-2004, 07:35 AM

I have posted this question on another site and still working on my own. Coming across some road blocks that I need help to resolve. I will give as much detail as possible.

My in-law's are in a small family run golf business(sales). When they go into clubs for presentations 70% of their time is devoted to making logo's by hand. I would like to help automate this process for them. I have created a userform for data entry however lack the skills to tie this all together.

I have the following on the Userform - UF_GolfLogo
Shape list box LB_Shape msoshape of the logo
Lenght Text Box TB_Lenght length of the logo
Height Text Box TB_Height height of the logo
# of lines Text Box TB_Lines # of text lines in logo
Background Pattern list box LB_BackGroundPattern mso Pattern
Background Color list box LB_BackGroundColor Background color of shape
Border Type List box LB_BorderType Type of border for shape
Border Color List Box LB_BorderColor Border color for shape
Line # 1 Information Text Box TB_Line1 First Line of text
Position List Box LB_Position1 Left,Center, Or Right
Font Type List Box LB_FontType1 Type of font for Line 1
Font Color List Box LB_FontColor1 Color of Line 1 font
Bold Check Box CB_Bold1 Bolds font if checked
Underline Check Box CB_Underline1 Underlines font if checked
Italics Check Box CB_Italics1 Italics font if checked
Font Outline Check Box CB_Outline1 Outlines font if checked
Shadow Check Box CB_Shadow1 Shadows font if checked
Font Size Text Box TB_FontSize1 Size of font for Line 1

From Line #1 information down is repeated for a total of 5 lines

I have a command button CB_View on the userform that when pressed will run the macro to create the logo on sheet1 for review. A Command button on sheet1 to send them back to the userform UF_GolfLogo if changes need to be made. I also will also be putting 2 command button's on sheet1 to "Print" the logo and another to "e-mail" the logo.

The following code is what I have so far:

Sub Test()
Dim sh As Shape
Set sh = ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, Application.InchesToPoints(6), Application.InchesToPoints(3))
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 18
Selection.ShapeRange.Line.Weight = 6
Selection.ShapeRange.Fill.Patterned msoPatternTrellis
Selection.Characters.Text = "XYZ Country Club" & "" & "Anywhere Open" & "" & Chr(10) & "Anywhere U.S.A"
With Selection.Characters(Start:=1, Length:=18).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 18
End With
With Selection.Characters(Start:=19, Length:=15).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 36
End With
With Selection.Characters(Start:=34, Length:=14).Font
.Name = "Roman"
.FontStyle = "Bold Italic"
.Size = 18
End With
Selection.HorizontalAlignment = xlCenter
End Sub

Everything is hardcoded. I need the List Boxes, Check Boxes, & Text Boxes to drive the options. The code above does work, however, limited to 1 specific logo.

I understand I am asking the world. I appreciate any help I can get.



07-07-2004, 01:05 PM
Hi Kurt,

Two requests that may increase your chances of a successful outcome.

1. If you have posted the query elsewhere please provide a link (and provide a link to this forum on the other site). This saves people wasting their time covering areas that may already have been covered.

2. Given the nature of your request you may find people more willing to offer help if you attach an example workbook with the userform already created, rather than relying on people taking the time to create it.

Daxton A.
07-07-2004, 02:20 PM
I agree w/Richie, I have a problem with understanding all of that Text that is put in there b/c I'm more of a picture person than a text person. Or put it in a Code window.

07-08-2004, 09:57 AM
Richie & Daxton -

I appreciate the words of wisdom. Will take the time to do so.


Daxton A.
07-08-2004, 10:46 AM
See if this helps

07-08-2004, 01:52 PM
Daxton -

I appreciate the time you have given me. The button works, however, everything is still hard coded. That's what I need to get to. I trying to get the flexability from the userform. Did I miss the boat on this one?



07-10-2004, 04:58 AM
Hi Kurt,

Essentially what you need to do is to use a Shape variable that you can refer to throughout your code. Then create the shape based upon the information contained in the userform.

There are two ways of getting the userform information. The first is to use Public variables (declared in a general module) and populate these with the userform data before it is unloaded. The second is to Hide the userform rather than Unload it. The latter would be my preferred method and this is what I have used in the attached example.

Rather than creating multiple shapes, that may be difficult to keep track of, the code uses just one shape that is deleted and then recreated on each execution of the code.

I don't have the time (nor, if I'm honest, the inclination ;) ) to provide a fully-working example with all of the features that you have on the userform, I have only covered the type of shape and the height and width. However, I believe that with the information that I have provided you should be able to complete the task for yourself.

Please note that I have not included any error-checking for cases where no entries are made - I will leave it to you to do this and implement whatever default values you want to use.

For those who are unwilling (or unable) to download files from the internet the code is as follows.

In the userform:

Private Sub CB_Review_Click()
End Sub

Private Sub UserForm_Initialize()
With LB_Shapes
.AddItem "Oval"
.AddItem "Rectangle"
.AddItem "Triangle"
.AddItem "Pentagon"
.AddItem "Trapezoid"
End With
End Sub

In a general module:

Const strShName As String = "GolfLogo"

Sub DisplayShape()
Dim shLogo As Shape, lType As Long
Dim lWidth As Long, lHeight As Long
'variables to work with
Const lLeft As Long = 100
Const lTop As Long = 150
'some constants
'show the userform
'delete any existing logo
Select Case UF_GolfLogo.LB_Shapes.Value
Case Is = "Oval": lType = 9 'msoShapeOval
Case Is = "Rectangle": lType = 1 'msoShapeRectangle
Case Is = "Triangle": lType = 7 'msoShapeIsoscelesTriangle
Case Is = "Pentagon": lType = 51 'msoShapePentagon
Case Is = "Trapezoid": lType = 3 'msoShapeTrapezoid
Case Else: lType = 1 'default if nothing selected
End Select
'determine type of shape to add
Set shLogo = Sheet1.Shapes.AddShape(lType, lLeft, lTop, 1, 1)
'add shape to work with (expression.AddShape(Type, Left, Top, Width, Height))
With UF_GolfLogo
lWidth = .TB_Length
lHeight = .TB_Height
End With
'get values from userform
With shLogo
.Name = strShName
.Width = lWidth
.Height = lHeight
End With
'apply values to shape
End Sub

Sub DeleteShape()
On Error Resume Next
On Error GoTo 0
End Sub

And in the ThisWorkbook object:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'clear old shapes to avoid showing details of last customer to current customer
End Sub

Workbook attachment:

07-12-2004, 04:59 AM

I appreciate your post and time you have given me.

Thank You for the direction you have provided.

After playing around for a minute I have a question for you. In reference to size - what scale is the size. I put 6 x 3 and it was the size of a dot. I then worked my way up to 100 X 100 which was obviously larger. This is not on an inch scale or a % scale what might it be?


07-12-2004, 05:11 AM
Hi Kurt,

Glad to have helped get you started.

Re the shape sizes - these are done in points. According to the Help files a point is approximately 1/72 of an inch. So yes, a 1x1 shape isn't going to be very big. ;)

Good luck with the project.

07-12-2004, 08:14 AM
Richie -

I was able to fix the size issue fairly easy.

2 parts of the general module code you provided have errors and I am not sure why:

DeleteShape - Compile error "Sub or Function not defined".

.Name = strShName - Run Time Error '70' "Access Denied".

On stepping through again - the .name = strShName error did not show.

What is your take on this? I commented out the delete shape and everything seems to work fine.