Word

En mi despacho hemos de imprimir documentos con diferentes mÁrgenes en cada pÁgina constantemente. Al no existir un objeto "pagina" en word es bastante abstruso hacer una macro que situe correctamente los margenes. He hecho una que lo hace como si los hiciera "manualmente" (va a pagina siguiente,vuelve a la ultima linea de la anterior, inserta un salto de seccion, etc. Utilizando goto, insertbreakpage...etc), pero, aunque cuando la ejecuto en modo interrupcion funciona correctamente, cuando lo hago en modo ejecucion el programa se hace la picha un lio y los saltos de seccion aparecen en lugares insospechados (sobre todo si hay unas cuantas hojas). ¿se te ocurre algo mas "depurado" que esta macro? Gracias por anticipado

1 respuesta

Respuesta
1
Disculpa el retraso, pero he estado bastante liado y no te he podido responder antes.
Crea una nueva macro llamada Margenes y ponle el siguiente código:
Sub Margenes()
'
' Macro grabada el 09/07/02 por Simón Hernández Dalmau
'
ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
InsertBreak Type:=wdSectionBreakNextPage
Selection.Start = Selection.Start + 1
With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _
Content.End).PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(InputBox("Introduzca el margen superior:"))
.BottomMargin = CentimetersToPoints(InputBox("Introduzca el margen inferior:"))
.LeftMargin = CentimetersToPoints(InputBox("Introduzca el margen izquierdo:"))
.RightMargin = CentimetersToPoints(InputBox("Introduzca el margen derecho:"))
.SectionStart = wdSectionNewPage
End With
End Sub
Esta macro inserta un salto de sección en el punto donde tienes el cursor (en tu caso ponlo al principio de la página a partir de la cual vas a cambiar los márgenes), y te pregunta los márgenes a aplicar en centímetros. Es posible que te añada alguna página de más, pero es lo más depurado que he conseguido hacer.
ME PARECE QUE NO ME HE EXPLICADO BIEN. LOS DOCUMENTOS QUE IMPRIMO TIENEN UN MARGEN DIFERENTE PARA PÁGINAS PARES E IMPARES Y DE LO QUE SE TRATA ES DE QUE LA MACRO PONGA BIEN TODOS LOS MÁRGENES UNA VEZ ACABADO EL DOCUMENTO (SI TENGO QUE IR PONIENDOLO PÁGINA POR PÁGINA "VOY DADO").GRACIAS DE TODAS FORMAS
PD.TE ADJUNTO LA MACRO QUE HE ELABORADO YO POR SI SE TE OCURRE ALGO PARA MEJORARLA (SOBRE TODO SIMPLIFICARLA, YA QUE COMO TE COMENTÉ EN LA PREGUNTA, EL PROGRAMA "SE LÍA" EN CUANTO HAY UNAS CUANTAS PÁGINAS). GRACIAS DE NUEVO.
Sub Formatear()
Dim NumPag As Integer
Selection.HomeKey unit:=wdStory
With ActiveDocument.Content
.Font.Name = "century gothic"
.Font.Size = 12
.ParagraphFormat.LineSpacing = 26
.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0.8)
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.Find.Replacement.ClearFormatting
.Find.Text = "^b"
.Find.Replacement.Text = ""
.Find.Execute Replace:=wdReplaceAll
End With
With ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(7.5)
.BottomMargin = CentimetersToPoints(4.3)
.LeftMargin = CentimetersToPoints(6)
.RightMargin = CentimetersToPoints(2)
.MirrorMargins = True
End With
NumPag = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
If NumPag < 3 Then
With Selection
.GoToNext what:=wdGoToPage
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(4)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
End If
If NumPag > 2 Then
If NumPag / 2 <> NumPag \ 2 Then
For n = 1 To (NumPag - 2) Step 2
With Selection
.GoTo what:=wdGoToPage, WHICH:=wdGoToAbsolute, Count:=(n + 1)
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(4)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
With Selection
.GoTo what:=wdGoToPage, WHICH:=wdGoToAbsolute, Count:=(n + 2)
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(7.5)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
Next
End If
If NumPag / 2 = NumPag \ 2 Then
For n = 1 To (NumPag - 3) Step 2
With Selection
.GoTo what:=wdGoToPage, WHICH:=wdGoToAbsolute, Count:=(n + 1)
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(4)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
With Selection
.GoTo what:=wdGoToPage, WHICH:=wdGoToAbsolute, Count:=(n + 2)
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(7.5)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
Next
With Selection
.GoTo what:=wdGoToPage, WHICH:=wdGoToAbsolute, Count:=numpage
.MoveUp unit:=wdLine, Count:=1
.EndKey unit:=wdLine
.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.TopMargin = CentimetersToPoints(4)
.PageSetup.BottomMargin = CentimetersToPoints(4.3)
.PageSetup.LeftMargin = CentimetersToPoints(6)
.PageSetup.RightMargin = CentimetersToPoints(4.3)
End With
End If
End If
Selection.HomeKey unit:=wdStory
End Sub
Aquí tienes el código de la macro que necesitas:
Sub Formatear()
'
' Macro grabada el 15/07/02 por Simón Hernández Dalmau
'
Selection.HomeKey Unit:=wdStory
' Cabecera de macro original
With ActiveDocument.Content
.Font.Name = "century gothic"
.Font.Size = 12
.ParagraphFormat.LineSpacing = 26
.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0.8)
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.Find.Replacement.ClearFormatting
.Find.Text = "^b"
.Find.Replacement.Text = ""
.Find.Execute Replace:=wdReplaceAll
End With
With ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(7.5)
.BottomMargin = CentimetersToPoints(4.3)
.LeftMargin = CentimetersToPoints(6)
.RightMargin = CentimetersToPoints(2)
.MirrorMargins = True
End With
i = 2
While i <= ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _
Content.End).PageSetup
' Márgenes según página
If i / 2 = i \ 2 Then
' Página par
.TopMargin = CentimetersToPoints(4)
Else
' Página impar
.TopMargin = CentimetersToPoints(7.5)
End If
' Márgenes comunes
.BottomMargin = CentimetersToPoints(4.3)
.LeftMargin = CentimetersToPoints(6)
.RightMargin = CentimetersToPoints(4.3)
.SectionStart = wdSectionNewPage
End With
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
InsertBreak Type:=wdSectionBreakNextPage
Selection.Start = Selection.Start + 1
i = i + 1
Wend
End Sub
La he probado con varios documentos y funciona casi a la perfección. El 'casi' es porque a veces añade un salto de página en la última página, pero lo quitas y listo.
Si tienes cualquier duda o te da algún problema, aquí me tienes.
Un saludo y disculpa el retraso, pero es que la macro se las trae :).

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas