OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 25-08-2009, 10:05
Posts: n/a
Talking how to make a vertical text?

i want to the text direction is vertical, how to deal with it in vba?
Reply With Quote
Old 26-08-2009, 11:45
Michael Cervantes
Posts: n/a
Default vertical text macro

Sub MCVerti()
Dim s As TextRange
Dim ap As String
Dim c As Long
Dim d As Document
Set d = ActiveDocument
d.BeginCommandGroup "MC Text Vertical"

On Error GoTo ErrHandler

ap = Left(AppWindow.Caption, 12)

If ActiveShape.Type = cdrTextShape Then
Set s = ActiveShape.Text.Story.Characters.All
ActiveTool = cdrToolDrawText
c = s.Characters.Count - 1

Do While c <> 0
AppActivate ap, False
SendKeys "{home}", True
SendKeys "{right}", True
SendKeys "{enter}", True
c = c - 1

s.Alignment = cdrCenterAlignment

z = s.Size
s.LineSpacing = 70

End If
Exit Sub

MsgBox "Error occured: " & Err.Description
Resume ExitSub

End Sub
Reply With Quote
Old 30-08-2009, 02:09
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,770
Blog Entries: 10
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Hotel Text

OK, here is my version. Should be a little faster as I don't use SendKeys. Also if the text it already in Hotel (Vertical) format it will put it back. It remembers linespacing and justification. Let me know if you would like to see other improvements. I have only tested in CorelDRAW X4.
Sub HotelText()
    Dim s As Shape, trChar As TextRange
    Set s = ActiveShape
    If s Is Nothing Then MsgBox "Please select some text.": Exit Sub
    If s.Type <> cdrTextShape Then MsgBox "Please select some text.": Exit Sub
    Optimization = True
    ActiveDocument.BeginCommandGroup "Hotel Text"
    On Error GoTo ErrHandler

    If s.Text.Story.Characters(2) = vbCr Then
        s.Properties("HotelText", 2) = s.Text.Story.LineSpacing
        s.Properties("HotelText", 3) = s.Text.Story.Alignment
        For Each trChar In s.Text.Story.Characters
            If trChar = vbCr Then trChar.Delete
        Next trChar
        If s.Properties("HotelText", 0) <> "" Then s.Text.Story.LineSpacing = s.Properties("HotelText", 0)
        If s.Properties("HotelText", 1) <> "" Then s.Text.Story.Alignment = s.Properties("HotelText", 1)
        s.Properties("HotelText", 0) = s.Text.Story.LineSpacing
        s.Properties("HotelText", 1) = s.Text.Story.Alignment
        For i = (s.Text.Story.Characters.Count - 1) To 1 Step -1
            s.Text.Story.Characters(i).InsertAfter vbCr
        Next i
        If s.Properties("HotelText", 2) <> "" Then s.Text.Story.LineSpacing = s.Properties("HotelText", 2)
        If s.Properties("HotelText", 3) <> "" Then
            s.Text.Story.Alignment = s.Properties("HotelText", 3)
            s.Text.Story.Alignment = cdrCenterAlignment
        End If
    End If
    Optimization = False
    Exit Sub

    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
End Sub
Best of luck,

Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
vertical text? fungel General 6 28-04-2010 01:52
How do you make an animated GIF? excessiveforce General 2 13-12-2006 05:36
PDF export vertical lines issue JIMXAV General 4 18-07-2006 00:06
Macro Escribir Vertical por Michael Cervantes Caminante General 2 25-05-2005 09:57
Vertical text justification blahville CorelDRAW/Corel DESIGNER VBA 3 03-11-2003 15:19

All times are GMT -5. The time now is 07:53.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com