Impresión y Guardar como Excel...

Hoy, el sitio estuvo un tanto errático. Espero que ahora (6ta vez) sí me permita pasarte la respuesta.
Dividamos tu pregunta en dos partes, pues ambas son bastante extensas:
a.- Listar impresoras
Habría dos vías para resolver este planteo. Uno burdo pero efectivo y otro de mayor complejidad.
El primero consiste en reproducir las teclas que se deberían presionar para llegar al cuadro de diálogo que permite la selección de la impresora y una vez hecho eso, presionar la tecla Cancelar. Por virtud de la forma de trabajo del administrador de impresiones de MS Excel, aún cancelando la acción la impresora seleccionada antes de cancelar queda vigente.
Tal macro sería tan simple como esta:
Sub SelePRN()
SendKeys "%A" '% equivale a la tecla "Alt" y A es por "Archivo"
SendKeys "I" 'atajo para "Imprimir"
Cancel = True
End Sub
En el otro extremo está, listar las impresoras disponibles en un equipo en un formulario de VBA.
Necesitarás insertar en tu formulario un cuadro de lista (Listbox), una Etiqueta (Label) y un botón de Comando (commandbutton)
Ahora es necesario, indicarle a VBA qué debe hacer con estos elementos.
La idea es mostrar en el cuadro de listas todas las impresoras instaladas en el equipo donde se ejecuta el programa. Al seleccionar alguna de ellas, su nombre también aparecerá en la etiqueta y con el botón de comando tomará tal selección.
Luego podrás usar ese dato como necesites en tu caso particular.
Debo aclarar que la rutina para determinar qué impresoras tiene el sistema NO es un desarrollo propio sino de:
KPD-Team 1999
URL: http://www.allapi.net/
E-Mail: [email protected]
Sobre esa base armé la rutina de cargar lo obtenido en el listbox.
Bien, dicho esto, sigo con el proceso:
Con F7 accederás al panel de declaraciones de este formulario.
Borra cualquier cosa que hubiera escrita allá y pega estas líneas de código:
''Adaptación de rutina MostrarImpresoras() de:
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'------------------------------
' Get information about all of the local printers using structure 1. Note how
' the elements of the array are loaded into an array of data structures manually. Also
' note how the following special declares must be used to allow numeric string pointers
' to be used in place of strings:
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Const PRINTER_ENUM_LOCAL = &H2
Private Type PRINTER_INFO_1
flags As Long
pDescription As String
pName As String
pComment As String
End Type
Private Sub UserForm_Initialize()
Dim longbuffer() As Long ' resizable array receives information from the function
Dim printinfo() As PRINTER_INFO_1 ' values inside longbuffer() will be put into here
Dim numbytes As Long ' size in bytes of longbuffer()
Dim numneeded As Long ' receives number of bytes necessary if longbuffer() is too small
Dim numprinters As Long ' receives number of printers found
Dim c As Integer, retval As Long ' counter variable & return value
'Me.AutoRedraw = True 'Set current graphic mode to persistent
' Get information about the local printers
numbytes = 3076 ' should be sufficiently big, but it may not be
ReDim longbuffer(0 To numbytes / 4) As Long ' resize array -- note how 1 Long = 4 bytes
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
If retval = 0 Then ' try enlarging longbuffer() to receive all necessary information
numbytes = numneeded
ReDim longbuffer(0 To numbytes / 4) As Long ' make it large enough
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
If retval = 0 Then ' failed again!
Debug.Print "Could not successfully enumerate the printes."
End ' abort program
End If
End If
' Convert longbuffer() data into printinfo()
If numprinters <> 0 Then ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1 ' room for each printer
For c = 0 To numprinters - 1 ' loop, putting each set of information into each element
' longbuffer(4 * c) = .flags, longbuffer(4 * c + 1) = .pDescription, etc.
' For each string, the string is first buffered to provide enough room, and then the string is copied.
printinfo(c).flags = longbuffer(4 * c)
printinfo(c).pDescription = Space(lstrlen(longbuffer(4 * c + 1)))
retval = lstrcpy(printinfo(c).pDescription, longbuffer(4 * c + 1))
printinfo(c).pName = Space(lstrlen(longbuffer(4 * c + 2)))
retval = lstrcpy(printinfo(c).pName, longbuffer(4 * c + 2))
printinfo(c).pComment = Space(lstrlen(longbuffer(4 * c + 3)))
retval = lstrcpy(printinfo(c).pComment, longbuffer(4 * c + 3))
Next c
' Display name of each printer
For c = 0 To numprinters - 1
ListBox1.AddItem printinfo(c).pName
'MsgBox "Name of printer" & c + 1 & " is: " & printinfo(c).pName
Next c
'control de existencia de elementos
If ListBox1.ListCount >= 1 Then
'Si no hay nada seleccionado, elige el primero
If ListBox1.ListIndex = -1 Then
ListBox1.ListIndex = 0 'ListBox1.ListCount - 1
End If
End If
End Sub
Private Sub ListBox1_Change()
Label1.Caption = ListBox1.List(ListBox1.ListIndex)
End Sub
Private Sub CommandButton1_Click()
Application.ActivePrinter = ListBox1.List(ListBox1.ListIndex) & " en LPT1:"
Unload Me
End Sub
---
Lo único que falta es una macro simple que llame a este formulario.
Inserta un módulo y pega un código como este:
Sub listaprn()
UserForm1.Show
End Sub
Como ves, esta vía es lejos más compleja, pero la decisión es tuya.
En la próxima respuesta te contesto la segunda parte de tu pregunta
Un momento.

Otra vez
Una macro que permita indicar la ubicación y nombre del archivo a guardar, podría ser algo com esto:
Sub GuardaComo()
fileSaveName = Application.GetSaveAsFilename(InitialFilename:="CAMBIAR", fILEfILTER:="Libro de Microsoft Excel (*.xls), *.xls", Title:=">>>>>>> Indique ubicación y nombre del Archivo <<<<<<<")
If fileSaveName <> False Then
ThisWorkbook.SaveAs FileName:=fileSaveName
MsgBox "GUARDADO como " & fileSaveName
Else
MsgBox "Este archivo NO fue guardado"
End If
End Sub
Por suerte, esta es más sencilla que la de las impresoras ;)
Espero que esto ayude a resolver tu problema.
Si así fuera, agradeceré un comentario y que la finalices.
(Recuerda que mantener cierto número de respuestas pendientes impide que otros usuarios puedan consultarme)
Un abrazo!
Fernando
"Me lo explicaron y lo olvidé,
lo leí y lo entendí,
lo hice y lo aprendí".
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
A cambio de mi tiempo, sólo te pido dos cosas:
- Finaliza (con puntaje y comentario) esta pregunta
- Ingresa al sitio www.porloschicos.com y, si quieres,
presiona el botón de donación (es gratis).
Confío en que lo harás.