imprimir selectivo

29/01/2008 - 18:40 por Jose | Informe spam
Con el código que a continuación expongo, imprimo una serie de fichas
correlativas mediante la entrada con InputBox de los numeros de las fichas
(primero y último)
Quisiera modificar este codigo para que me imprimiera determinadas fichas
cuyos numeros no son correlativos pero que pertenecen a un rango nombrado
por ejemplo CP30010 entre otros rangos a elegir y cuya composición de
numeros puede variar en la cantidad y que se encuentran en filas sucesivas
de la misma columna.
Los titulos de los rangos se encuentra en la Hoja "Murcia", en la fila 2 y
los numeros empiezan en la fila 4 con una longitud de filas variable, cada
titulo en una columna diferente y por ello necesito las líneas de codigo
necesarias para elegir un titulo o nombre de rango e imprimir los numeros de
fichas que lo compongan.
He aqui un ejemplo:

1ª linea columna K 1ª linea columna L 1ª linea columna M
CP30007 CP30008 CP30009 ...(2ª línea)
MURCIA MURCIA MURCIA..(3ª línea)
765 790 26 ... 4ª
551 541 527 ... 5ª
599 644 ... 6ª
.. etc.
685
40


Sub Imprimirfichasdeclientes()
'

Dim N As Integer
Dim x As Integer, contador
On Error Resume Next

N = InputBox("Introduce el código de la primera ficha a imprimir", "Primer
número", "1")
x = InputBox("Introduce el código de la última ficha a imprimir", "Último
número", "830")
contador = 1
y = InputBox("¿Cancelar impresión?", "si quiere cancelar intruzca un 0, sino
1", "1")
If y = 0 Then End
Sheets("Plantilla").Select
For N = N To x

Application.Run "'Listado nº 9 de todos los clientes al
10-1-08.xls'!Imprimirestaficha"

contador = contador + 1

End If
If N = x + 1 Then Exit Sub

Next
MsgBox ("el nº de fichas es: ") & contador - 1
End Sub

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
30/01/2008 - 08:09 | Informe spam
hola, Jose !

no se aprecia que haga tu macro en: -> Application.Run "'Listado nº 9 de todos los clientes al 10-1-08.xls'!Imprimirestaficha"
pero creo que podrias probar con algo +/- como lo siguiente y...
si cualquier duda (o informacion adicional mas... "especifica")... comentas ?
saludos,
hector.

Sub ImprimeFichasDelRango_X()
Dim Celda As Range, Listado As Range
On Error Resume Next ' por si las dudas '
Application.ScreenUpdating = True ' el refresco de la pantalla debe estar activo '
Worksheets("murcia").Select
Set Listado = Application.InputBox( _
Prompt:="Selecciona el titulo del listado...", _
Title:="En espera de la seleccion...", _
Default:=$K$2, _
Type:=8) ' Type:=8 significa que se espera que el usuario seleccione un objeto rango '
On Error GoTo 0 ' liberamos la omision de errores '
If Listado Is Nothing Then MsgBox "Operacion cancelada !": Exit Sub
Application.ScreenUpdating = False ' congelamos el refresco de la pantalla '
For Each Celda In Range(Cells(4, Listado.Column), Cells(4, Listado.Column).End(xlDown))
' AQUI es (casi) seguro que "algo" necesitaras hacer con el contenido de cada "Celda" ?????? '
Application.Run "'Listado nº 9 de todos los clientes al 10-1-08.xls'!Imprimirestaficha"
Next
Set Listado = Nothing
End Sub

__ la consulta original __
Con el codigo que a continuacion expongo, imprimo una serie de fichas correlativas
mediante la entrada con InputBox de los numeros de las fichas (primero y ultimo)
Quisiera modificar este codigo para que me imprimiera determinadas fichas cuyos numeros no son correlativos
pero que pertenecen a un rango nombrado por ejemplo CP30010 entre otros rangos a elegir
y cuya composicion de numeros puede variar en la cantidad y que se encuentran en filas sucesivas de la misma columna.
Los titulos de los rangos se encuentra en la Hoja "Murcia", en la fila 2 y los numeros empiezan en la fila 4
con una longitud de filas variable, cada titulo en una columna diferente y por ello necesito las líneas de codigo
necesarias para elegir un titulo o nombre de rango e imprimir los numeros de fichas que lo compongan.
He aqui un ejemplo:
1ª linea columna K 1ª linea columna L 1ª linea columna M
CP30007 CP30008 CP30009 ...(2ª línea)
MURCIA MURCIA MURCIA..(3ª línea)
765 790 26 ... 4ª
551 541 527 ... 5ª
599 644 ... 6ª
.. etc.
685
40

Sub Imprimirfichasdeclientes()
Dim N As Integer
Dim x As Integer, contador
On Error Resume Next
N = InputBox("Introduce el codigo de la primera ficha a imprimir", "Primer numero", "1")
x = InputBox("Introduce el codigo de la ultima ficha a imprimir", "Ultimo numero", "830")
contador = 1
y = InputBox("Cancelar impresion?", "si quiere cancelar intruzca un 0, sino 1", "1")
If y = 0 Then End
Sheets("Plantilla").Select
For N = N To x
Application.Run "'Listado nº 9 de todos los clientes al 10-1-08.xls'!Imprimirestaficha"
contador = contador + 1
End If
If N = x + 1 Then Exit Sub
Next
MsgBox ("el nº de fichas es: ") & contador - 1
End Sub
Respuesta Responder a este mensaje
#2 José Rafael
30/01/2008 - 15:59 | Informe spam
Gracias Héctor el código funciona perfectamente. Ruego me revises las
adaptaciones que le he ido haciendo. Ver mas abajo.
Solo tiene una "pega" ... la impresión de fichas se hace "eterna"... es muy
lenta...
¿Se puede hacer algo?.
Saludos y gracias de nuevo
José Rafael


Sub ImprimeFichasDelRango_X()
Dim Celda As Range, Listado As Range
Dim N As Integer, Y As Integer
Dim Imprime As String
Dim salida As Integer
Dim pestaña As String
On Error Resume Next ' por si las dudas '
Application.ScreenUpdating = True ' el refresco de la pantalla debe estar
activo '
'Ahora elegimos la hoja de cálculo correspondiente bajo la variable
pestaña
pestaña = InputBox("(a) Murcia" + Chr(10) + "(b) Teruel/Valencia" +
Chr(10) + "(c) Albacete/Alicante" + Chr(10) + "(d) anular", "Elegir la hoja
de provincia", "b")
If pestaña = "a" Then pestaña = "Murcia": Worksheets(pestaña).Select
If pestaña = "b" Then pestaña = "Teruel y Valencia":
Worksheets(pestaña).Select
If pestaña = "c" Then pestaña = "Albacete y Alicante":
Worksheets(pestaña).Select
If pestaña = "d" Then Beep: MsgBox "SALIMOS": Selection.AutoFilter:
Sheets("Murcia").Select: End
If pestaña = "" Then Beep: MsgBox "SALIMOS": Selection.AutoFilter:
Sheets("Murcia").Select: End
criterio = InputBox("Código postal, 0 = anular", pestaña, "00000")
If criterio = 0 Then Beep: MsgBox "SALIMOS": Selection.AutoFilter:
Sheets("Murcia").Select: End
If criterio = "" Then Beep: MsgBox "SALIMOS": Selection.AutoFilter:
Sheets("Murcia").Select: End
Worksheets(pestaña).Select
MsgBox (pestaña)
Range("A1").Select
Set Listado = Application.InputBox(Prompt:="Selecciona el titulo del
listado...", Title:="En espera de la seleccion...", _
Default:=Range("D1").Value, Type:=8) ' Type:=8 significa que se
espera que el usuario seleccione un objeto rango '
On Error GoTo 0 ' liberamos la omision de errores '

If Listado Is Nothing Then MsgBox "Operacion cancelada !": Exit Sub

Application.ScreenUpdating = False ' congelamos el refresco de la pantalla
'
x = Listado.Count 'contamos las fichas del rango
If x >= 100 Then Exit Sub
For Y = 1 To x
For Each Celda In Range(Cells(4, Listado.Column), Cells(4,
Listado.Column).End(xlDown))

N = Celda.Value
If N = 0 Then MsgBox ("Salimos porque N= " & N & ", " & "Y=" & Y & "
x=" & x): Exit Sub
'Lo anterior es para saber el valor de las variables...
Sheets("Ficha").Select
Range("J1") = N

' AQUI es (casi) seguro que "algo" necesitaras hacer con el
contenido de cada "Celda" ?????? '
'NO FUNCIONABA :Application.Run "'Listado nº 9 de todos los clientes
al 10-1-08.xls'!Imprimirestaficha"
Imprime = InputBox("Imprimir la ficha nº " & N, "Sí o no", "Sí")
If Imprime <> "Sí" Then GoTo salida Else 'marcamos la salida
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True (ACTIVAR
CUANDO SE QUIERA IMPRIMIR)
'Ahora sustituimos la impresión por un aviso MsgBox
MsgBox ("Imprimiendo la ficha nº " & N & " correspondiente a la
extracción nº " & Y & " del rango " & criterio)
salida: Y = Y + 1
Next
If Y > x Then Exit Sub
Next Y

Set Listado = Nothing
End Sub









"Héctor Miguel" escribió en el mensaje
news:
hola, Jose !

no se aprecia que haga tu macro en: -> Application.Run "'Listado nº 9 de
todos los clientes al 10-1-08.xls'!Imprimirestaficha"
pero creo que podrias probar con algo +/- como lo siguiente y...
si cualquier duda (o informacion adicional mas... "especifica")...
comentas ?
saludos,
hector.

Sub ImprimeFichasDelRango_X()
Dim Celda As Range, Listado As Range
On Error Resume Next ' por si las dudas '
Application.ScreenUpdating = True ' el refresco de la pantalla debe estar
activo '
Worksheets("murcia").Select
Set Listado = Application.InputBox( _
Prompt:="Selecciona el titulo del listado...", _
Title:="En espera de la seleccion...", _
Default:=$K$2, _
Type:=8) ' Type:=8 significa que se espera que el usuario
seleccione un objeto rango '
On Error GoTo 0 ' liberamos la omision de errores '
If Listado Is Nothing Then MsgBox "Operacion cancelada !": Exit Sub
Application.ScreenUpdating = False ' congelamos el refresco de la
pantalla '
For Each Celda In Range(Cells(4, Listado.Column), Cells(4,
Listado.Column).End(xlDown))
' AQUI es (casi) seguro que "algo" necesitaras hacer con el contenido
de cada "Celda" ?????? '
Application.Run "'Listado nº 9 de todos los clientes al
10-1-08.xls'!Imprimirestaficha"
Next
Set Listado = Nothing
End Sub

__ la consulta original __
Con el codigo que a continuacion expongo, imprimo una serie de fichas
correlativas
mediante la entrada con InputBox de los numeros de las fichas (primero y
ultimo)
Quisiera modificar este codigo para que me imprimiera determinadas fichas
cuyos numeros no son correlativos
pero que pertenecen a un rango nombrado por ejemplo CP30010 entre otros
rangos a elegir
y cuya composicion de numeros puede variar en la cantidad y que se
encuentran en filas sucesivas de la misma columna.
Los titulos de los rangos se encuentra en la Hoja "Murcia", en la fila 2
y los numeros empiezan en la fila 4
con una longitud de filas variable, cada titulo en una columna diferente
y por ello necesito las líneas de codigo
necesarias para elegir un titulo o nombre de rango e imprimir los numeros
de fichas que lo compongan.
He aqui un ejemplo:
1ª linea columna K 1ª linea columna L 1ª linea columna M
CP30007 CP30008 CP30009 ...(2ª línea)
MURCIA MURCIA MURCIA..(3ª línea)
765 790 26 ... 4ª
551 541 527 ... 5ª
599 644 ... 6ª
.. etc.
685
40

Sub Imprimirfichasdeclientes()
Dim N As Integer
Dim x As Integer, contador
On Error Resume Next
N = InputBox("Introduce el codigo de la primera ficha a imprimir",
"Primer numero", "1")
x = InputBox("Introduce el codigo de la ultima ficha a imprimir", "Ultimo
numero", "830")
contador = 1
y = InputBox("Cancelar impresion?", "si quiere cancelar intruzca un 0,
sino 1", "1")
If y = 0 Then End
Sheets("Plantilla").Select
For N = N To x
Application.Run "'Listado nº 9 de todos los clientes al
10-1-08.xls'!Imprimirestaficha"
contador = contador + 1
End If
If N = x + 1 Then Exit Sub
Next
MsgBox ("el nº de fichas es: ") & contador - 1
End Sub




Respuesta Responder a este mensaje
#3 Héctor Miguel
31/01/2008 - 06:07 | Informe spam
hola, José !

... el codigo funciona
... me revises las adaptaciones que le he ido haciendo. Ver mas abajo.
Solo tiene una "pega" ... la impresion de fichas se hace "eterna"... es muy lenta...
Se puede hacer algo?...



1) la lentitud que mencionas se debe a que tienes dos bucles y el interior se repite n_veces (segun el exterior)
2) ya te habia comentado no saber "que hace" la linea con el "Application.Run una macro en otro libro" -???-
3) tambien te comentaba que "algo" (suponia) debias hacer con el contendo de cada "Celda" (en el For Each Celda In...)
4) las otras fallas que mencionas (debo decirte que)... cuando la realidad es diferente de lo expuesto en la consuta... -??????-
5) en este (nuevo ?) caso, tampoco es claro "que" contiene el rango "D1" que pones como Default al Application.InputBox
6) la instruccion On Error Resume Next solo es necesaria para prevenir omisiones (ANTES) del Application.InputBox
7) tambien tienes un uso "excesivo" de la instruccion "End" (te sugiero cambiarla por un Exit Sub)
8) el Application.InputBox solo necesita como referencia UNA celda "dentro" del rango con el listado (segun solicitado originalmente)
9) tampoco le veo el caso a mostrar un MsgBox CADA VEZ previo a cada impresion (quieres imprimir ?... si o no ?)
(hay mas :-(( pero creo que podemos simplificar la lentitud si modificas solo estas lineas):

de:
x = Listado.Count 'contamos las fichas del rango
If x >= 100 Then Exit Sub
For Y = 1 To x
For Each Celda In Range(Cells(4, Listado.Column), Cells(4, Listado.Column).End(xlDown))
N = Celda.Value
If N = 0 Then MsgBox ("Salimos porque N= " & N & ", " & "Y=" & Y & " x=" & x): Exit Sub
'Lo anterior es para saber el valor de las variables...
Sheets("Ficha").Select
Range("J1") = N
' AQUI es (casi) seguro que "algo" necesitaras hacer con el contenido de cada "Celda" ?????? '
'NO FUNCIONABA :Application.Run "'Listado nº 9 de todos los clientes al 10-1-08.xls'!Imprimirestaficha"
Imprime = InputBox("Imprimir la ficha nº " & N, "Sí o no", "Sí")
If Imprime <> "Sí" Then GoTo salida Else 'marcamos la salida
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True (ACTIVAR CUANDO SE QUIERA IMPRIMIR)
'Ahora sustituimos la impresión por un aviso MsgBox
MsgBox ("Imprimiendo la ficha nº " & N & " correspondiente a la extracción nº " & Y & " del rango " & criterio)
salida: Y = Y + 1
Next
If Y > x Then Exit Sub

a:
For Each Celda In Range(Cells(4, Listado.Column), Cells(4, Listado.Column).End(xlDown))
With Worksheets("ficha")
.Range("j1") = Celda
' .PrintOut ' ACTIVAR CUANDO SE REQUIERA IMPRIMIR '
MsgBox "Imprimiendo la ficha " & Celda & " correspondiente a la extraccion del rango " & criterio
End With
Next

-> OJO: solo "decide bien" si el rango de codigos es realmente a partir de la fila 4 y hasta la ultima celda no vacia -> .End(xlDown)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida