Macro Ajustar Area de Impresion a una Hoja

[heral]

Hola, les consulto como crear una macro que ajuste el area de impresion del tamaño de una hoja de alto por una hoja de ancho de varios archivos de una carpeta.

Lo intente con la grabadora de macros, pero no funciona. Cada archivo solo contiene una hoja con una tabla de de 7 columnas (A:G) y la cantidad de filas es variable (aproximadamente puede ir de unas 10 filas a unas 200 filas ). 

Esta macro la estaria agregando a otra que saqué del sitio de ron de bruin, que toma un libro con varias hojas y crea un nuevo libro por cada hoja:(https://www.rondebruin.nl/win/s3/win007.htm). 

Aclaro que los archivos no se van a imprimir, sino que se van a subir a un sitio web que a su vez los convierte en pdf automaticamente para que otras personas lo puedan visualizar.

Muchas gracias,

Hernan

[xafel]

prueba con esta macro, es de elsamatilde de todoexpertos, yo la tengo en un botón de la hoja que quiero que imprima, espero te funcione

 

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

'limpio el area
ActiveSheet.PageSetup.PrintArea = ""
'doy formato a la pagina
With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .LeftMargin = Application.InchesToPoints(0.45)
    .TopMargin = Application.InchesToPoints(0.36)
    .BottomMargin = Application.InchesToPoints(0.04)
    .PrintTitleRows = "$1:$3"
    .LeftFooter = "Ejemplar para el cliente"
    .RightFooter = "&P de &N"
   
End With
'Selecciono A1
rango1 = Range("A1").Select
rango1 = Selection.Address

'selecciono l'ultima
Fila = Range("a65536").End(xlUp).Row + 20
'se agrega la col siguiente paralas tablas dinamicas
rango2 = Range(Selection, Cells(Fila, 6)).Select
rango2 = Selection.Address

' lleno l'area d'impresion i mostro el missatge
Ans = MsgBox("Se va a imprimir el rango" & " " & rango2, vbYesNo)
' pregunto si o no

'si es "si" imprimeixo
If Ans = vbYes Then
ActiveSheet.PageSetup.PrintArea = rango2

'VISTA PRELIMINAR
ActiveWindow.SelectedSheets.PrintPreview

'imprimeixo directament
'PrintOut

'torno a demanr l'informe i canvio la linea de leftfooter
With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .LeftMargin = Application.InchesToPoints(0.45)
    .TopMargin = Application.InchesToPoints(0.36)
    .BottomMargin = Application.InchesToPoints(0.04)
    .PrintTitleRows = "$1:$3"
    .LeftFooter = "Ejemplar para la arquitecto"
    .RightFooter = "&P de &N"
   
End With
'Selecciono A1
rango1 = Range("A1").Select
rango1 = Selection.Address

'selecciono l'ultima
Fila = Range("a65536").End(xlUp).Row + 20
'se agrega la col siguiente paralas tablas dinamicas
rango2 = Range(Selection, Cells(Fila, 6)).Select
rango2 = Selection.Address
PrintOut

'si es "no" borro l'area
Else
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.Orientation = xlPortrait
Range("j1").Select
End If

End Sub