1º crear texto con formato triangular

1º Explico lo que necesito y luego os doy la explicación

Necesito colocar el cursor en el nº de carácter que yo le diga en un
inputbox

gracias.

AHORA LA EXPLICACIÓN:


Vamos a ver cómo se podría hacer esto, no sé ni si hay que hacerlo en
word, aunque yo creo que sí:

Estoy trabajando la mejora de la velocidad lectora, y preparar textos para
ello se me hace bastante farragoso así que pretendo crear un pequeño
programita que me convierta un texto cualquiera en el formato que
necesito:

hay varias opciones de formato y por ello he puesto 1º, aunque seguramente
luego os preguntaré alguna más.

Necesitaría que me convirtiera el texto en un triángulo para mejorar la
amplitud lectora en un golpe de vista, para ello, necesito que cada línea
empiece permitiendo poner palabras en por ejemplo 1 cm, la siguiente 1,5
cm
la siguiente 2 cm y así hasta el tamaño que yo quisiera. Repitiéndose la
sucesión de tamaño. y creando algo así como un triángulo con las palabras.

Solución que he pensado (necesitaría ayuda):

He pensado preguntar la amplitud máxima y la mínima, una vez que la
sabemos, y teniendo el texto que es,
haría algo así, contar las letras (con una fuente que tenga todas las
letras del mismo tamaño) sabiendo esto cojo todas
las letras que ocupen los centímetros cuando los supere, iríamos al primer
espacio y haríamos un "intro" a la siguiente línea
y así de nuevo.

Para poder hacer esto, necesito sé contar el número de carácteres, pero no
sé cómo coloco el cursor en el carácter que yo quiero

bueno por fin, hay quizá algún desajuste que si quieres corregirlo

pero me sirve aquí te lo dejo

Sub CrearTextoEnTriangulos()
Dim Ndocumento As String
Dim texto As String
Dim n As Long 'amplitud
Dim i As Long 'inicio
Dim f As Long 'numero caracteres que aumenta hasta los espacios


Ndocumento = ActiveDocument.Name

Documents.Add.SaveAs ("nuevo.doc")

'documento inicial
Documents(Ndocumento).Activate
i = 1
'n es cómo iniciamos de amplitud
n = 3

ActiveDocument.Select
texto = ""
Do


f = InStr(i + n, Selection.Text, " ", 1)
'Debug.Print f & " " & i & " " & n

If Len(texto) = 0 Then
texto = Mid(Selection.Text, i, f - i)
Else
If f = 0 Then
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i)
Else
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i, f -
i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i, f - i)
End If
End If
i = f + 1
'MsgBox texto
'20 es la longitud máxima de la amplitud
If n > 30 Then
n = 3
Else
n = n + 3
End If

Loop While f <> 0


Documents("nuevo.doc").Activate
ActiveDocument.Content.InsertAfter Text:=texto
ActiveDocument.Select
Selection.Paragraphs.Alignment = wdAlignParagraphCenter


End Sub

Muy buena eChiri :-) !! pues la he prodado y queda muy chuli me la voy a
guardar :-P te habra costado mucho trabajo tela marinera ;-) !!!

Muchisimas gracias por el aporte Chiri ;-) ;-) !!

Saludos
Monica





> bueno por fin, hay quizá algún desajuste que si quieres corregirlo
perfecto,

pero me sirve aquí te lo dejo

Sub CrearTextoEnTriangulos()
Dim Ndocumento As String
Dim texto As String
Dim n As Long 'amplitud
Dim i As Long 'inicio
Dim f As Long 'numero caracteres que aumenta hasta los espacios


Ndocumento = ActiveDocument.Name

Documents.Add.SaveAs ("nuevo.doc")

'documento inicial
Documents(Ndocumento).Activate
i = 1
'n es cómo iniciamos de amplitud
n = 3

ActiveDocument.Select
texto = ""
Do


f = InStr(i + n, Selection.Text, " ", 1)
'Debug.Print f & " " & i & " " & n

If Len(texto) = 0 Then
texto = Mid(Selection.Text, i, f - i)
Else
If f = 0 Then
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i)
Else
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i,
f - i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i, f - i)
End If
End If
i = f + 1
'MsgBox texto
'20 es la longitud máxima de la amplitud
If n > 30 Then
n = 3
Else
n = n + 3
End If

Loop While f <> 0


Documents("nuevo.doc").Activate
ActiveDocument.Content.InsertAfter Text:=texto
ActiveDocument.Select
Selection.Paragraphs.Alignment = wdAlignParagraphCenter


End Sub

Gracias.

Ahora voy a por otra un texto de varias líneas, entre línea y línea quiero
poner puntos, para que se pueda trabajar a golpes de vista la lectura

voy a intentarlo, te haré seguro preguntas si no me sale alguna cosilla.

un abrazo
"Monica May" escribió en el mensaje
news:

Muy buena eChiri :-) !! pues la he prodado y queda muy chuli me la voy a
guardar :-P te habra costado mucho trabajo tela marinera ;-) !!!

Muchisimas gracias por el aporte Chiri ;-) ;-) !!

Saludos
Monica





> bueno por fin, hay quizá algún desajuste que si quieres corregirlo
perfecto,

pero me sirve aquí te lo dejo

Sub CrearTextoEnTriangulos()
Dim Ndocumento As String
Dim texto As String
Dim n As Long 'amplitud
Dim i As Long 'inicio
Dim f As Long 'numero caracteres que aumenta hasta los espacios


Ndocumento = ActiveDocument.Name

Documents.Add.SaveAs ("nuevo.doc")

'documento inicial
Documents(Ndocumento).Activate
i = 1
'n es cómo iniciamos de amplitud
n = 3

ActiveDocument.Select
texto = ""
Do


f = InStr(i + n, Selection.Text, " ", 1)
'Debug.Print f & " " & i & " " & n

If Len(texto) = 0 Then
texto = Mid(Selection.Text, i, f - i)
Else
If f = 0 Then
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i,
Len(Selection.Text) - i)
Else
'texto = texto & Chr(10) & Chr(13) & Mid(Selection.Text, i,
f - i) 'se me crean dos espacios
texto = texto & Chr(13) & Mid(Selection.Text, i, f - i)
End If
End If
i = f + 1
'MsgBox texto
'20 es la longitud máxima de la amplitud
If n > 30 Then
n = 3
Else
n = n + 3
End If

Loop While f <> 0


Documents("nuevo.doc").Activate
ActiveDocument.Content.InsertAfter Text:=texto
ActiveDocument.Select
Selection.Paragraphs.Alignment = wdAlignParagraphCenter


End Sub