Macro Escribir Vertical por Michael Cervantes

Siguiendo las instrucciones:

Abrimos el notepad de windows.

<img src="http://img166.exs.cx/img166/6856/12gb.jpg" border="0" alt="Imagen IPB" />

Abierto asi tal cual lo grabamos solo que modificar para no grabarlo como TXT, seleccionar la opcion en tipo de archivo All files despues NOMBREARCHIVO.GMS.

<img src="http://img166.exs.cx/img166/6905/20jk.jpg" border="0" alt="Imagen IPB" />

Buscamos la ruta donde se instalan estas acciones, DrawScripts

<img src="http://img166.exs.cx/img166/1306/35dq.jpg" border="0" alt="Imagen IPB" />

Posteriormente abrimos Corel y vamos al editor de visual basic

<img src="http://img166.exs.cx/img166/9748/47pi.jpg" border="0" alt="Imagen IPB" />

Seleccionamos nuestra rutina.

<img src="http://img166.exs.cx/img166/1909/52rx.jpg" border="0" alt="Imagen IPB" />

Abierto el editor seleccionamos nuestro documento, y click boton derecho para adicionar las siguientes lineas.

<img src="http://img166.exs.cx/img166/6497/65ju.jpg" border="0" alt="Imagen IPB" />

Las cuales quedaran así

<img src="http://img166.exs.cx/img166/6979/76lc.jpg" border="0" alt="Imagen IPB" />

<!--quoteo--><div class='quotetop'>CITA</div><div class='quotemain'><!--quotec-->Dim s As TextRange
Dim ap As String
Dim c As Long

Sub MCVerti()
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
Loop
s.Alignment = cdrCenterAlignment
s.LineSpacing = 80

End If<!--QuoteEnd--></div><!--QuoteEEnd-->

Ahora lo anterior hay que ajustarlo para que las ordenes sigan sin ningun problema.

<img src="http://img166.exs.cx/img166/9885/86jq.jpg" border="0" alt="Imagen IPB" />

Lo grabamos y regresamos a corel donde tenemos nuestro texto de prueba.

<img src="http://img166.exs.cx/img166/8175/96fj.jpg" border="0" alt="Imagen IPB" />

Ejecutamos la macro.

<img src="http://img166.exs.cx/img166/9151/102lq.jpg" border="0" alt="Imagen IPB" />

Y automáticamente se activa.

<img src="http://img166.exs.cx/img166/1599/113bc.jpg" border="0" alt="Imagen IPB" />

Quedando de la siguiente forma.

<img src="http://img166.exs.cx/img166/7489/121ol.jpg" border="0" alt="Imagen IPB" />

Ahora al ejecutarlo me marco algunos errores y al final tenia que agregar una orden como lo marco en la siguiente imagen.

<img src="http://img166.exs.cx/img166/8261/134rv.jpg" border="0" alt="Imagen IPB" />

Las alineaciones de las ordenas las hice en el notepad y las pegue al editor de Vidual Basic.

El texto con las adiciones:

<!--quoteo--><div class='quotetop'>CITA</div><div class='quotemain'><!--quotec-->Dim s As TextRange
Dim ap As String
Dim c As Long

Sub MCVerti()
&nbsp;ap = Left(AppWindow.Caption, 12)

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

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

&nbsp; &nbsp; Loop
s.Alignment = cdrCenterAlignment
s.LineSpacing = 80

&nbsp; End If

End Sub<!--QuoteEnd--></div><!--QuoteEEnd-->

 

Gracias