Hola colegas, buenas tardes y que tengan una excelente salud.
Tengo un pequeño proyecto para controlar los comensales, pero necesito una hoja para llevar de manera manual las incidencias. ya tengo hecho todo, excepto que necesito en la Hoja Modelo, en la columna E me ponga una linea en la parte inferior de las celdas (Para Firmar), siempre que existan datos.
Yo tengo este código:
Private Sub BtnImprimirM_Click()
Dim X As Long
Application.ScreenUpdating = False
Hoja10.Range("A4:D5000").Clear
Worksheets("BD Alumnos").Range("A4:D5000").Copy Worksheets("Modelo").Range("A4")
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' Selection.Borders(xlDiagonalDown).LineStyle = xlNone
' Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' Selection.Borders(xlEdgeLeft).LineStyle = xlNone
' Selection.Borders(xlEdgeTop).LineStyle = xlNone
' Selection.Borders(xlEdgeBottom).LineStyle = xlNone
' Selection.Borders(xlEdgeRight).LineStyle = xlNone
' Selection.Borders(xlInsideVertical).LineStyle = xlNone
' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B4:D5000").Select
ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Add2 Key:=Range("D4:D5000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Modelo").Sort
.SetRange Range("B3:D5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A4").Select
MsgBox "Datos Actualizados e Imprimiendo...", vbInformation, "Sistemas COLOSSUS"
Sheets("Modelo").Select
X = Application.Dialogs(xlDialogPrinterSetup).Show
If X = False Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Application.ScreenUpdating = True
End Sub
Pensé crear una varibale para determianr la última fila, pero aun así, despues de varios intentos no logré hacerlo. Este listado puede variar con más o menos trabajadores diarios.
Hola colegas, buenas tardes y que tengan una excelente salud.
Tengo un pequeño proyecto para controlar los comensales, pero necesito una hoja para llevar de manera manual las incidencias. ya tengo hecho todo, excepto que necesito en la Hoja Modelo, en la columna E me ponga una linea en la parte inferior de las celdas (Para Firmar), siempre que existan datos.
Yo tengo este código:
Private Sub BtnImprimirM_Click() Dim X As Long Application.ScreenUpdating = False Hoja10.Range("A4:D5000").Clear Worksheets("BD Alumnos").Range("A4:D5000").Copy Worksheets("Modelo").Range("A4") With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With ' Selection.Borders(xlDiagonalDown).LineStyle = xlNone ' Selection.Borders(xlDiagonalUp).LineStyle = xlNone ' Selection.Borders(xlEdgeLeft).LineStyle = xlNone ' Selection.Borders(xlEdgeTop).LineStyle = xlNone ' Selection.Borders(xlEdgeBottom).LineStyle = xlNone ' Selection.Borders(xlEdgeRight).LineStyle = xlNone ' Selection.Borders(xlInsideVertical).LineStyle = xlNone ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("B4:D5000").Select ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Add2 Key:=Range("D4:D5000") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Modelo").Sort .SetRange Range("B3:D5000") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A4").Select MsgBox "Datos Actualizados e Imprimiendo...", vbInformation, "Sistemas COLOSSUS" Sheets("Modelo").Select X = Application.Dialogs(xlDialogPrinterSetup).Show If X = False Then Exit Sub ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Application.ScreenUpdating = True End Sub
Pensé crear una varibale para determianr la última fila, pero aun así, despues de varios intentos no logré hacerlo. Este listado puede variar con más o menos trabajadores diarios.
Por favor, si me pueden ayudar se los agradeceré.
Adjunto archivo.
Mis respetos.
Pino
Resumen de Comensales Lavandería JSD.xlsm