Mejora en macro "boleta de notas excel "
Para Dante Amor
Hola dante amor un saludo cordial, deseo mejorar la macro que un momento me diste solución.
En la hoja FRM que es la plantilla para la generación de la boleta está a una escala de 52% pero cuando genero la boleta lo arroja en 39% la cual mis boletas sale muy pequeña las letras.
Deseo que se mantenga por lo menos en unos 49 a 52 % si es posible
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Envíame el archivo con la macro.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “” y el título de esta pregunta.
ya le envíe Dante el archivo
Te anexo la macro con algunos ajustes:
Sub boletas()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("C1")
For Each h In Sheets
If InStr(1, h.Name, "Boleta") Then
h.Delete
Exit For
End If
Next
Set h2 = Sheets.Add(After:=Sheets(Sheets.Count))
h2.Name = "Boleta"
Set h3 = Sheets("frm")
h3.Range("A1:AM40").Copy
h2.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
j = 1
For i = 26 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "K") = "" Then Exit For
h3.Range("A1:AM40").Copy h2.Range("A" & j)
h2.Range("AJ" & j + 16) = h1.Cells(i, "A")
n = 1
For k = j To j + 40
alto = h3.Rows(n).RowHeight
h2.Rows(k).RowHeight = alto
n = n + 1
Next
j = j + 41
Next
'For k = 1 To Columns("AM").Column
' ancho = h3.Columns(k).ColumnWidth
' h2.Columns(k).ColumnWidth = ancho
'Next
h2.Select
n = 1
l = 83
h2.PageSetup.PrintArea = ""
With h2.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.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 = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 52
.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
'
u = h2.Range("B" & Rows.Count).End(xlUp).Row + 10
h2.PageSetup.PrintArea = "A1:AH" & u
h2.ResetAllPageBreaks
ActiveWindow.View = xlPageBreakPreview
On Error Resume Next
h2.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
For Each s In h2.HPageBreaks
Set h2.HPageBreaks(n).Location = h2.Range("A" & l)
n = n + 1
l = l + 82
Next
'
h2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\Boleta de " & ThisWorkbook.Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
Application.ScreenUpdating = True
MsgBox "El proceso de generación de boletas ha terminado", vbInformation, "BOLETAS"
End Subsal u dos
