Consulting

Results 1 to 10 of 10

Thread: Creating Logo Via Userform Input

  1. #1

    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.
    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:


    [VBA]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[/VBA]


    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

  2. #2
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    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.

  3. #3
    VBAX Contributor Daxton A.'s Avatar
    Joined
    Jun 2004
    Location
    Biloxi, Mississippi
    Posts
    134
    Location

    Talking

    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.

  4. #4
    Richie & Daxton -


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


    Kurt

  5. #5
    VBAX Contributor Daxton A.'s Avatar
    Joined
    Jun 2004
    Location
    Biloxi, Mississippi
    Posts
    134
    Location

    :)

    See if this helps

  6. #6
    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

  7. #7
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    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:[vba]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[/vba]In a general module:[vba]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[/vba]And in the ThisWorkbook object:[vba]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[/vba]

    Workbook attachment:

  8. #8
    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

  9. #9
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    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.

  10. #10
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •