IMPRIMIR SERIES DESDE EXCEL
Hola
He creado una macro que hace aproximadamente lo que quieres, solo que NO lo imprime cada vez,
sino que genera unas nuevas hojas con el numero del pedido en el libro excel para que tu la puedas imprimir individualmente.
Se respetan las hojas "IMPRIMIR", "SERIES", "BASE".
Se borran el resto de hojas cada vez que se ejecuta.
En la hoja SERIES hay que poner cabecera en la fila 1... "SERIE" y "PEDIDO".
Se verifica que la estructura de las hojas del libro sea la adecuada y sino... se finaliza.
Se ordenan las hojas ascendentemente.
No se alteran ni modifican las hojas originales.
Y creo que he hecho aprox lo que solicitabas... y no me he dejado nada...
Espero que te sirva como base para modificarla a tu gusto.
A la macro la he llamado "A_IMPRIMIR_SERIES_BASE".
Sal-u2 by TPA
BYE
Option Explicit
Option Base 1 'para que los arrays empiecen por 1
Sub MacrosRapidasInicio(valor As Integer)
Application.ScreenUpdating = False
' Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
End Sub
Sub MacrosRapidasFin(valor As Integer)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
' ActiveSheet.DisplayPageBreaks=True
Application.CutCopyMode = False
End Sub
'-----------------------------------------------------------------------
'-----------------------------------------------------------------------
'-----------------------------------------------------------------------
Sub A_IMPRIMIR_SERIES_BASE()
'
Dim Hoja As Worksheet
Dim estaHojaBASE As Integer
Dim estaHojaSERIES As Integer
Dim estaHojaIMPRIMIR As Integer
Dim filas_BASE As Integer
Dim filas_SERIES As Integer
Dim numero_PEDIDO As String
Dim conta_CODIGOS As Integer
Dim conta_SERIES As Integer
Dim filas1, filas2 As Long
Dim fila, columna As Integer
Call MacrosRapidasInicio(1)
'Borrar hojas que se usan
Application.DisplayAlerts = False
estaHojaBASE = 0
estaHojaSERIES = 0
estaHojaIMPRIMIR = 0
For Each Hoja In Worksheets
Select Case Hoja.Name
Case "BASE"
estaHojaBASE = 1
Case "SERIES"
estaHojaSERIES = 1
Case "IMPRIMIR"
estaHojaIMPRIMIR = 1
Case Else
Hoja.Delete
End Select
Next Hoja
Application.DisplayAlerts = True
'comprobamos que existan las tres hojas necesarias
If estaHojaBASE = 0 _
Or estaHojaSERIES = 0 _
Or estaHojaIMPRIMIR = 0 _
Then
Exit Sub
End If
'comprobamos que la estructuras de las hojas sean correctas...
Sheets("BASE").Select
If Range("A1").Value = "PEDIDO" _
And Range("B1").Value = "CODIGO" _
And Range("C1").Value = "CLIENTE" _
Then
filas_BASE = Range("A" & Rows.Count).End(xlUp).Row
' ordenar ascendentemente por A=PEDIDO, B=CODIGO, C=CLIENTE
Cells.Select
ActiveWorkbook.Worksheets("BASE").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BASE").Sort.SortFields. _
Add Key:=Range("A2:A" & filas_BASE), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BASE").Sort.SortFields. _
Add Key:=Range("B2:B" & filas_BASE), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BASE").Sort.SortFields. _
Add Key:=Range("C2:C" & filas_BASE), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("BASE").Sort
.SetRange Range("A1:C" & filas_BASE)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Else
Exit Sub
End If
Sheets("SERIES").Select
If Range("A1").Value = "SERIE" _
And Range("B1").Value = "PEDIDO" _
Then
filas_SERIES = Range("A" & Rows.Count).End(xlUp).Row
' ordenar ascendentemente por B=PEDIDO, A=SERIE
Cells.Select
ActiveWorkbook.Worksheets("SERIES").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SERIES").Sort.SortFields. _
Add Key:=Range("B2:B" & filas_SERIES), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SERIES").Sort.SortFields. _
Add Key:=Range("A2:A" & filas_SERIES), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SERIES").Sort
.SetRange Range("A1:B" & filas_SERIES)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Else
Exit Sub
End If
Sheets("IMPRIMIR").Select
If Range("D2").Value = "PEDIDO " _
And Range("D4").Value = "CLIENTE" _
And Range("A6").Value = "CODIGOS" _
Then
' Ya de paso limpiamos el contenido de la hoja de impresion
Range("B11:I110").Select
Selection.ClearContents
Range("C7:I8").Select
Selection.ClearContents
Else
Exit Sub
End If
' procesamos la hoja BASE
numero_PEDIDO = ""
Sheets("BASE").Select
For filas1 = 2 To filas_BASE
If Range("BASE!A" & filas1).Value <> numero_PEDIDO _
Then
numero_PEDIDO = Range("BASE!A" & filas1).Value
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Select ' La selecciona
ActiveSheet.Name = numero_PEDIDO ' le cambia el nombre
Sheets("IMPRIMIR").Select
Range("A1:I121").Select
Selection.Copy
Sheets(numero_PEDIDO).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E2").Value = Range("BASE!A" & filas1).Value
Range("E4").Value = Range("BASE!C" & filas1).Value
Range("C6").Value = Range("BASE!B" & filas1).Value
conta_SERIES = 0
For filas2 = 2 To filas_SERIES
If Range("SERIES!B" & filas2).Value = numero_PEDIDO _
Then
conta_SERIES = conta_SERIES + 1
fila = 11 + ((conta_SERIES - 1) \ 8)
columna = 2 + ((conta_SERIES - 1) Mod 8)
Cells(fila, columna).Value = "'" & Range("SERIES!A" & filas2).Value
End If
Next filas2
Else
Range("C6").Value = Range("C6").Value & " " & Range("BASE!B" & filas1).Value
End If
Next filas1
'Y volvemos a la hoja de Notas inicial
Call MacrosRapidasFin(1)
Sheets("BASE").Select
Range("A1").Select
End Sub
Sub SERIES()
End Sub
Sub LIMPIAR()
'
' LIMPIAR Macro
'
'
Sheet("IMPRIMIR").Select
Range("B11:I110").Select
Selection.ClearContents
Sheets("SERIES").Select
Columns("A:A").Select
Selection.ClearContents
Range("A1").Select
End Sub
