Macro que defina el tamaño de página y que se mantenga desde usuarios distintos

Tengo una macro que configura el tamaño de mi página y la imprime en pdf y funciona sin problemas, la duda es por que la línea .PaperSize = 133 (que obtuve al grabar la macro) no funciona desde otra pc, la duda viene debido a que distintos usuarios usaran la herramienta y necesito garantizar que en cualquier pc funcionara. Que debo hacer, ¿configurar o cambiar para que esa línea sea entendida desde distintas PC's? Ya intente con la forma

.PaperSize = .xlPaperLetter y tampoco funciona.

Aca dejo la macro que estoy usando.

Sub Suma_Funciones()

'Page setup
With Worksheets("Cotizacion").PageSetup
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(0.2)
.BottomMargin = Application.CentimetersToPoints(0.2)
.HeaderMargin = Application.CentimetersToPoints(0)
.FooterMargin = Application.CentimetersToPoints(0)
.PaperSize = 133
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1

End With

Dim Num_contar As Integer
Dim Aux As Integer
Ruta = ThisWorkbook.Path & "\" 'Misma ruta del origen
nomb = Range("H3").Value 'Nombre de hoja
'nomb = ActiveSheet.Name 'Nombre de hoja
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Ruta & nomb & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False 'Despues de creado, no abre el archivo PDF

End Sub

1

1 Respuesta

4.213.225 pts. Sancho, si los perros ladran ...

H o l a:

¿Las otras pc's tienen la misma impresora?

Me ha pasado en ocasiones que si quito líneas de código de los parámetros, la impresión no resulta la misma; pero si dejo todos los parámetros que resultan cuando grabo la macro, entonces sí funciona.

Vuelve a grabar la macro y deja todos los parámetros en tu macro:

Sub Macro3()
'
' Macro3 Macro
'
'
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

Agrega después del End With 

Dim Num_contar As Integer
Dim Aux As Integer
Ruta = ThisWorkbook.Path & "\" 'Misma ruta del origen
nomb = Range("H3").Value 'Nombre de hoja
'nomb = ActiveSheet.Name 'Nombre de hoja
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Ruta & nomb & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False 'Despues de creado, no abre el archivo PDF


Prueba y me comentas.



':)
S a l u d o s . D a n t e A m o r
':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.

Hola Dante

Primero que todo muchas gracias por tu valioso apoyo.

Te comento que si ejecuto la macro en la misma pc donde grabe la macro me va excelente. El problema viene cuando guardo el archivo y lo envío por correo al usuario que dará uso al archivo. En su pc tengo que cambiar la variable .PaperSize = 133 por .PaperSize = 119 para que no me de error de compilación.

En una de las maquinas tengo instalado solo el acrobat como medio de impresión, y en la otra el acrobat más 3 impresoras más.

¿No existe alguna forma para definir dentro de la macro de forma manual el tamaño de la hoja en centímetros o pulg?

Nuevamente gracias.


                

H o l a:

En la numeración de la size de la hoja no veo la numeración 119 o 133.

https://msdn.microsoft.com/en-us/library/office/ff839964.aspx 


Sin embargo, supongo que es por la versión de office, el tipo de impresora o el software de pdf que se tenga instalado.

Prueba con lo siguiente:

        '.PaperSize = xlPaperLetter
        On Error Resume Next
        .PaperSize = 133
        werr = Err.Number
        If werr <> 0 Then
            werr = 0
            .PaperSize = 119
            werr = Err.Number
            If werr <> 0 Then
                .PaperSize = 1
            End If
        End If

Intenta poner 133, si no se puede, entonces intenta poner 119, si no se puede entonces pone el 1 (xlPaperLetter)


Sal u dos

¡Gracias! 

Gracias por tu tiempo y apoyo amigo.

Al principio no me funciono del todo, después agregue una opción mas pero siguiendo tu lógica de la evaluación del error y me funciono, solo le puse que ademas intentara configurar con la opción que indica vba para la hoja carta y funciono. Hasta ahora en 3 pc´s distintas la macro corre sin problema, aunque no logro entender la razón de la diferencia.

Acá dejo la que funciono gracias a tu ayuda.

 On Error Resume Next
.PaperSize = 133
werr = Err.Number
If werr <> 0 Then
werr = 0
.PaperSize = 119
werr = Err.Number
If werr <> 0 Then
.PaperSize = 1
werr = Err.Number
If werr <> 0 Then
werr = 0
.PaperSize = xlPaperLetter
End If
End If
End If

Saludos y muchas gracias. 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas