Results 1 to 10 of 10

Rotating label / Text Orientation in VBA

This is a discussion on Rotating label / Text Orientation in VBA within the Excel Questions forums, part of the Question Forums category; Hi all, Just wondering, how do you rotate a label or orientate a text vertically in a VBA userform? Tq... ...

  1. #1
    New Member nadzri's Avatar
    Join Date
    Oct 2005
    Posts
    38

    Default Rotating label / Text Orientation in VBA

    Hi all,

    Just wondering, how do you rotate a label or orientate a text vertically in a VBA userform?

    Tq...

    Nadz

  2. #2
    MrExcel MVP
    Moderator
    Andrew Poulsom's Avatar
    Join Date
    Jul 2002
    Posts
    70,342

    Default

    There is no direct way. You may be able to achieve the effect you want by having a tall narrow label and setting its WordWrap property to True.

  3. #3
    New Member nadzri's Avatar
    Join Date
    Oct 2005
    Posts
    38

    Default

    Hi Andrew,

    Thank for your reply, but is there a way to orientate the text as well?


  4. #4
    MrExcel MVP Andrew Fergus's Avatar
    Join Date
    Sep 2004
    Location
    New Zealand
    Posts
    5,240

    Default

    Hi Nadz

    I haven't seen this done (or tried it) in VBA but I did in VB6 recently by following this snippet of code here:

    http://www.a1vbcode.com/snippet-3401.asp

    To get this to work, you actually display the text in a picture box, not a text box or a label (assuming you are using a form).

    You might want to see if you can adapt that code for what you want (the coding in VB6 is just about identical to VBA).

    HTH, Andrew
    ~ >*()))><(


    I'd rather have a full bottle in front of me than a full frontal lobotomy.

  5. #5
    New Member nadzri's Avatar
    Join Date
    Oct 2005
    Posts
    38

    Default

    Hi Andrew,

    thanks for the snippet link.

    I actually tought about that, but i only have a code that refer to a file in the hard disk:

    image1.Picture = _
    LoadPicture("C:\My Documents\My Pictures\Nadzri.jpg")

    I need to send this file to multiple recipient, if they were to copy the picture somewhere else, the code will not work. is there a code that can refer to an image inside the workbook itself?

    Thanks...

  6. #6
    MrExcel MVP Andrew Fergus's Avatar
    Join Date
    Sep 2004
    Location
    New Zealand
    Posts
    5,240

    Default

    Hi Nadz
    Maybe you misunderstood me - or I'm misunderstanding picture boxes on forms in Excel. The 'picture box' the code refers to is just an empty picture box on the form itself - the code will put the text into the empty picture box.
    Andrew
    ~ >*()))><(


    I'd rather have a full bottle in front of me than a full frontal lobotomy.

  7. #7
    New Member nadzri's Avatar
    Join Date
    Oct 2005
    Posts
    38

    Default

    Hi Andrew,

    My idea is to capture an image that have the word and load the image when it is required but the image have to be from within the worksheet.

    By the way, still trying the code that you gave me... give me a few minutes...

    cheers

  8. #8
    New Member nadzri's Avatar
    Join Date
    Oct 2005
    Posts
    38

    Default

    Hi Andrew,

    i've tried few times but I cant seem to be able to run your code. it say user defined type not defined.

    what should i do?

  9. #9
    MrExcel MVP Andrew Fergus's Avatar
    Join Date
    Sep 2004
    Location
    New Zealand
    Posts
    5,240

    Default

    Hi

    The code snippet from VB6 required almost a total re-write but I did (sort of) get the following to work in Excel VBA. I didn't have to enable any unusual references. I created a form with a blank image box (Image1) and a control button (CommandButton1). There are a couple of issues (see my notes at the top of the code) and anyone please feel free to correct my code for errors / improvements. Here is the code :

    Code:
    Option Explicit
    
    '*********************************************************************
    '
    'Written / adapted by Andrew Fergus (andrew93) 2 Nov 2006
    'in response to this question :
    'http://www.mrexcel.com/board2/viewtopic.php?p=1155825#1155825
    'on MrExcel.com
    '
    'This is still in the process of being developed
    '
    'Known issues :
    'The roatated text height is not 100% correct (assumptions made)
    'The background colour is white - not sure how to change
    'The choice of font colours are like the colour choices for the Model T
    'No options yet for fancy text formatting
    '
    'Feel free to correct my code!
    '
    '*********************************************************************
    
    Private Declare Function CreateFontIndirect Lib "gdi32" _
        Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    
    Private Declare Function SelectObject Lib "gdi32" _
        (ByVal hDC As Long, ByVal hObject As Long) As Long
    
    Private Declare Function DeleteObject Lib "gdi32" _
        (ByVal hObject As Long) As Long
    
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
      ByVal hDC As Long) As Long
    
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
      ByVal nIndex As Long) As Long
    
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
        (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _
        ByVal lpString As String, ByVal nCount As Long) As Long
    
    Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As String * 1
        lfUnderline As String * 1
        lfStrikeOut As String * 1
        lfCharSet As String * 1
        lfOutPrecision As String * 1
        lfClipPrecision As String * 1
        lfQuality As String * 1
        lfPitchAndFamily As String * 1
        lfFaceName As String * 32
    End Type
    
    Const HWND_DESKTOP As Long = 0
    Const LOGPIXELSX As Long = 88
    Const LOGPIXELSY As Long = 90
    
    Private Sub CommandButton1_Click()
    
    Dim strMyText As String
    
    strMyText = "Hello World"
    'Image1 is the name of the image control from the form
    
    Call RotateText(Image1, strMyText, Image1.Left + (Image1.Width / 3), Image1.Height + Image1.Top)
    
    End Sub
    
    Private Sub RotateText(PBCtrl As Image, disptxt As String, CX, CY)
    
    Dim Font As LOGFONT
    Dim hFont As Long, ret As Long, MyHDC As Long
    Dim xPos As Long, yPos As Long
    
    'Desired point size of font
    Const FONTSIZE = 9
    
    Font.lfEscapement = 900    ' 90-degree rotation (ie desired rotation in degrees x 10)
    Font.lfFaceName = "Arial" + Chr$(0)     'only tested with true type fonts
    Font.lfWeight = 50
    Font.lfHeight = (FONTSIZE * -20) / TwipsPerPixelY
    
    hFont = CreateFontIndirect(Font)
    MyHDC = GetDC(0&)
    ret = SelectObject(MyHDC, hFont)
    
    xPos = (((Me.Width - Me.InsideWidth) / 2 + Me.Left + CX) * (20 / TwipsPerPixelX))
    yPos = (((Me.Height - Me.InsideHeight) * 0.75 + Me.Top + CY) * (20 / TwipsPerPixelY))
    'I'm having some trouble with the height position so used the 0.75 as a 'fix'
    
    ret = TextOut(MyHDC, xPos, yPos, disptxt, Len(disptxt))
    
    'Clean up
    ret = DeleteObject(hFont)
    ReleaseDC 0&, MyHDC
    
    End Sub
    
    Function TwipsPerPixelY() As Single
      
      Dim lngDC As Long
      lngDC = GetDC(HWND_DESKTOP)
      TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
      ReleaseDC HWND_DESKTOP, lngDC
    
    End Function
    
    Function TwipsPerPixelX() As Single
      
      Dim lngDC As Long
      lngDC = GetDC(HWND_DESKTOP)
      TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
      ReleaseDC HWND_DESKTOP, lngDC
    
    End Function
    HTH, Andrew
    ~ >*()))><(


    I'd rather have a full bottle in front of me than a full frontal lobotomy.

  10. #10
    MrExcel MVP Andrew Fergus's Avatar
    Join Date
    Sep 2004
    Location
    New Zealand
    Posts
    5,240

    Default

    The following fixes should be applied to get more accurate positioning of the text over the image box :

    Code:
    Call RotateText(Image1, strMyText, Image1.Left + (Image1.Width / 2), Image1.Height + Image1.Top)
    and

    Code:
    xPos = ((((Me.Width - Me.InsideWidth - FONTSIZE) / 2 + Me.Left + CX) - 1) * (20 / TwipsPerPixelX))
    yPos = (((Me.Height - Me.InsideHeight + Me.Top + CY - ((Me.Width - Me.InsideWidth) / 2)) - 1) * (20 / TwipsPerPixelY))
    Please note this code is only useful for turning the text through angels from 0 through to about 90 degrees. I haven't adapted it for the likes of 180 or 270 degrees.

    Andrew
    ~ >*()))><(


    I'd rather have a full bottle in front of me than a full frontal lobotomy.

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com