Como hacer para que al ejecutar un botón de nombre Imprimir, me aparezca primero la vista preliminar

Tengo un Userform de Nombre frmCaptura, en el userform hay un botón de nombre Imprimir, necesito el código para que cuando ejecute el botón imprimir primero me aparezca la vista preliminar para poder realizar los ajustes necesarios a la impresión y después de realizar los ajustes poder imprimir el userform con todo su contenido.

2 Respuestas

Respuesta
1

Si quieres ver en vista preliminar alguna hoja, primero tienes que poner la propiedad ShowModal = false, por ejemplo:

En el botón pon lo siguiente, cambia "Hoja1" por la hoja que quieras imprimir.

Private Sub CommandButton1_Click()
    Sheet("Hoja1").PrintPreview
End Sub

Pero si lo que quieres es imprimir el formulario, entonces pon el botón lo siguiente:

Private Sub CommandButton1_Click()
    Me.PrintForm
End Sub

La instrucción anterior enviará una imagen de tu formulario directamente a la impresora.


Si quieres ver la imagen de tu formulario en una vista previa, primero que habría que pasar el formulario a una hoja y entonces ocupara la instrucción para la vista previa de una hoja, por ejemplo:

Private Sub CommandButton1_Click()
    Set h1 = Sheets.Add
    Application.SendKeys "(%{1068})"
    DoEvents
    ActiveSheet.Paste
    ActiveSheet.PrintPreview
    Application.DisplayAlerts = False
    h1.Delete
End Sub

Con esta macro, toma una impresión de pantalla de tu formulario, crea una hoja, en esa hoja pega la pantalla y te muestra en vista preliminar la nueva hoja.


Por último, si lo que quieres es ver los datos del formulario en una vista previa, primero tendrías que pasar los datos a una hoja y después utilizar la instrucción de vista previa sobre esa hoja, pero tendría que saber que controles tienes para pasarlos a la hoja, textbox, listbox, etc y qué es lo que quieres pasar.

Espero que te sirva la explicación.


Buenos días, muchas gracias por tu información, te comento, el código que enviaste efectivamente si hace lo que dices, pero el formulario siempre permanece activo y no deja ver lo de la vista preliminar, impidiendo ver los cambios que se realizan, al código que enviaste le agregue la instrucción frmCaptura.Hide y si oculta el formulario, pero en la impresión no me muestra los datos capturados, me imprime un formulario con los textlabel en blanco.

Te agradezco mucho me puedas colaborar con este asunto, de antemano muchas gracias y en espera de la solución, que tengas buen día

¿Pero cuál opción estás ocupando?

Buenos días, la instrucción que estoy usando es:

Private Sub CommandButton1_Click()    Set h1 = Sheets.Add    Application.SendKeys "(%{1068})"    DoEvents    ActiveSheet.Paste    ActiveSheet.PrintPreview    Application.DisplayAlerts = False    h1.DeleteEnd Sub

¿A cuál impresión te refieres?

Lo que hace la macro es enviar una imagen de tu formulario a la hoja, es un "pintscreen", entonces si en los textobox tienes datos y en el printpreview los estás viendo al momento de imprimirlo deben salir.

Si lo que quieres es pasar los datos del textbox a la impresora, pero si cierras el formulario, los datos que están en los textbox son destruidos, ya que esos datos se encuentran en la memoria. Lo que debes hacer es pasar esos datos a una hoja, guardar la hoja y posteriormente los podrás imprimir. Esa es una opción.

También revisa el color de la letra, quizás si la veas en el formulario y al momento de que lo imprimes en papel ya no se ve la letra, todo esto lo estoy suponiendo, porque todavía no entiendo que es lo que precisas.

No he recibido comentarios, podrías valorar la respuesta.

Buenas noches, no se ha solucionado lo que quiero, te envió el código para que lo ejecutes y observes lo que esta sucediendo.

Private Sub UserForm_Initialize()

Rem Me.Width = Application.Width
Rem Me.Height = Application.Height
Rem Posiciona el userform donde deseo en la Hoja de Excel
Rem Me.Top = 30
Rem Me.Left = 1200
End Sub

Private Sub Valor_Change()
Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor, ",", ""), ".", "")) / 100, "#,##0.00")
Valor = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor.SelStart
Valor.SelStart = iPosCursor
KeyCode = 0
End Sub

Private Sub Valor_Cheque_Change()

Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_Cheque, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_Cheque = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_Cheque.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_Cheque.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_Cheque.SelStart
Valor_Cheque.SelStart = iPosCursor
KeyCode = 0

End Sub

Private Sub Valor_Cheque1_Change()

Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_Cheque1, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_Cheque1 = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_Cheque1.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_Cheque1.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_Cheque1.SelStart
Valor_Cheque1.SelStart = iPosCursor
KeyCode = 0

End Sub

Private Sub Valor_Cheque2_Change()

Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_Cheque2, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_Cheque2 = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_Cheque2.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_Cheque2.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_Cheque2.SelStart
Valor_Cheque2.SelStart = iPosCursor
KeyCode = 0

End Sub

Private Sub Valor_Cheque3_Change()

Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_Cheque3, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_Cheque3 = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_Cheque3.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_Cheque3.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_Cheque3.SelStart
Valor_Cheque3.SelStart = iPosCursor
KeyCode = 0

End Sub

Private Sub Valor_ICA_Change()

Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_ICA, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_ICA = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_ICA.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_ICA.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_ICA.SelStart
Valor_ICA.SelStart = iPosCursor
KeyCode = 0
Valor_ICA = strCad
Valor_Pagar = Orden_Pago - Valor_Retencion - Valor_ICA
End Sub

Private Sub Valor_Pagar_Change()

Dim strCad As String
strCad = Format(Val(Replace(Replace(Valor_Pagar, ",", ""), ".", "")) / 100, "#,##0.00")
End Sub

Private Sub Valor_Retencion_Change()
Dim strCad As String
Dim i
Application.ScreenUpdating = False
strCad = Format(Val(Replace(Replace(Valor_Retencion, ",", ""), ".", "")) / 100, "#,##0.00")
Valor_Retencion = strCad
If iPosCursor = 0 Then
iPosCursor = Len(strCad) + 1
Else
iPosCursor = Valor_Retencion.SelStart
End If
If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
If KeyCode = 8 Then iPosCursor = Valor_Retencion.SelStart + 1
If KeyCode = 46 Then iPosCursor = Valor_Retencion.SelStart
Valor_Retencion.SelStart = iPosCursor
KeyCode = 0
Valor_Retencion = strCad
Valor_Pagar = Orden_Pago - Valor_Retencion
End Sub

Private Sub UserForm_Initialize()
    Rem Me.Width = Application.Width
    Rem Me.Height = Application.Height
    Rem Posiciona el userform donde deseo en la Hoja de Excel
    Rem Me.Top = 30
    Rem Me.Left = 1200
End Sub
Private Sub Valor_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor.SelStart
        Valor.SelStart = iPosCursor
        KeyCode = 0
End Sub
Private Sub Valor_Cheque_Change()
        Dim strCad As String
        Dim i
        Application.ScreenUpdating = False
        strCad = Format(Val(Replace(Replace(Valor_Cheque, ",", ""), ".", "")) / 100, "#,##0.00")
        Valor_Cheque = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_Cheque.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_Cheque.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_Cheque.SelStart
        Valor_Cheque.SelStart = iPosCursor
        KeyCode = 0
End Sub
Private Sub Valor_Cheque1_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor_Cheque1, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor_Cheque1 = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_Cheque1.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_Cheque1.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_Cheque1.SelStart
        Valor_Cheque1.SelStart = iPosCursor
        KeyCode = 0
End Sub
Private Sub Valor_Cheque2_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor_Cheque2, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor_Cheque2 = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_Cheque2.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_Cheque2.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_Cheque2.SelStart
        Valor_Cheque2.SelStart = iPosCursor
        KeyCode = 0
End Sub
Private Sub Valor_Cheque3_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor_Cheque3, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor_Cheque3 = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_Cheque3.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_Cheque3.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_Cheque3.SelStart
        Valor_Cheque3.SelStart = iPosCursor
        KeyCode = 0
End Sub
Private Sub Valor_ICA_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor_ICA, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor_ICA = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_ICA.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_ICA.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_ICA.SelStart
        Valor_ICA.SelStart = iPosCursor
        KeyCode = 0
        Valor_ICA = strCad
        Valor_Pagar = Orden_Pago - Valor_Retencion - Valor_ICA
End Sub
Private Sub Valor_Pagar_Change()
    Dim strCad As String
    strCad = Format(Val(Replace(Replace(Valor_Pagar, ",", ""), ".", "")) / 100, "#,##0.00")
End Sub
Private Sub Valor_Retencion_Change()
    Dim strCad As String
    Dim i
    Application.ScreenUpdating = False
    strCad = Format(Val(Replace(Replace(Valor_Retencion, ",", ""), ".", "")) / 100, "#,##0.00")
    Valor_Retencion = strCad
        If iPosCursor = 0 Then
        iPosCursor = Len(strCad) + 1
        Else
        iPosCursor = Valor_Retencion.SelStart
        End If
        If KeyCode = 37 Or KeyCode = 39 Then KeyCode = 0: Exit Sub
        If KeyCode = 8 Then iPosCursor = Valor_Retencion.SelStart + 1
        If KeyCode = 46 Then iPosCursor = Valor_Retencion.SelStart
        Valor_Retencion.SelStart = iPosCursor
        KeyCode = 0
        Valor_Retencion = strCad
        Valor_Pagar = Orden_Pago - Valor_Retencion
End Sub

Pero no entiendo qué es lo que necesitas, te envié un código para imprimir tu userform, eso fue lo que pediste o qué es lo que necesitas, qué problema tienes con tu código. En el código no veo lo que yo te envié.

Buenos días Dante, muchas gracias por tu atención, te envié el código para que tu lo ejecutes y verifiques que al presionar clic en el boton de imprimir se despliega el formulario y no permite que se puedan realizar los cambios pertinentes para la impresión a impresora. Te envió

una imagen de como es que se ejecuta.

Si me puedes colaborar con el código te lo agradezco inmensamente

Pero para hacer la prueba completa necesito tu archivo con tu formulario.

Envíame tu archivo a [email protected], en el archivo me pones las imágenes de lo que quieres, todo explicado con ejemplos.

En el asunto del correo escribe tu nombre de usuario y el título de esta pregunta, avísame cuando me lo hayas enviado.

Haber si entendí, ¿lo qué quieres llevar a la vista preliminar es la imagen del formulario?

Si es así, te regreso el archivo con la macro actualizada.

Puedes presionar tu botón de "Imprimir", te presenta la imagen del formulario en presentación preliminar, puedes ajustar la vista, preliminar y enviarla a imprimir. Cuando cierras la vista preliminar, en automático te regresa al formulario.

Este es el código:

Private Sub cmdImprimir_Click()
    'Me.PrintForm
'Act.Por.Dante Amor
    Application.ScreenUpdating = True
    Set h1 = Sheets.Add
    Application.SendKeys "(%{1068})"
    DoEvents
    ActiveSheet.Paste
    Me.Hide
    ActiveSheet.PrintPreview
    Me.Show
    Application.DisplayAlerts = False
    h1.Delete
End Sub

Excelente, muchas gracias, si es lo que deseo, una ultima pregunta, como hago para que no aparezcan los bordes de la ventana al momento de enviar a imprimir la imagen del formulario??

Podrías valorar esta respuesta y crear una nueva. Si lo deseas, al final del título de la nueva pregunta puedes poner que va dirigida a Dante Amor.

En la pregunta me pones una imagen de lo que quieres enviar a imprimir

Respuesta
1

Prueba con esto:

ActiveSheet. PrintPreview

Por favor, si te ha valido la respuesta, puntúala y cierra la pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas