[SLEEPER:] Creating Logo Via Userform Input

Creating Logo Via Userform Input

Folks,

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.

Code:

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:

Code:

Sub Test() Dim sh As Shape Set sh = ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, Application.InchesToPoints(6), Application.InchesToPoints(3)) sh.Select 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.

Thanks,

Kurt

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.

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.

Richie & Daxton -

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

Kurt

:)

See if this helps

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?

Thanks,

Kurt

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:

Code:

Private Sub CB_Review_Click() Me.Hide 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:

Code:

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 UF_GolfLogo.Show 'show the userform DeleteShape '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 Sheet1.Shapes(strShName).Delete On Error GoTo 0 End Sub

And in the ThisWorkbook object:

Code:

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

Workbook attachment:

Richie,

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?

Kurt

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.

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.

Thanks,

Kurt