Option Compare Database
Option Explicit
'********************************************************************************************
'Fecha Creación: 20/07/2002
'Desarrollador: McPegasus, www.mcpegasus.es.org
'Contacto: Ruego envíes tus comentarios y mejoras a: mcpegasus@iespana.es
'Propósito: Imprimir un documento en Vista Previa o Imprimir presentando el cuadro _
de diálogo para seleccionar la impresora.
'********************************************************************************************
Private Sub Demomc_Imprimir()
Dim strRptNombre As String
strRptNombre = "rptBuscar"
Call mc_Imprimir(False, strRptNombre, 2)
End Sub
Public Function mc_Imprimir(blnVistaPrevia As Boolean, strInforme As String, _
Optional intCopias As Integer = 1, Optional strFrmNombre)
'Última actualización: 20/07/2002
'Imprimir un documento presentando el cuadro de diálogo para seleccionar la impresora.
'NOTAS: _
- Se establece como Function en lugar de Sub, para poder referenciar el procedimiento _
en una base de datos externa. _
- Se necesita la función mc_blnComprobarInforme, componente del Clan McPegasus. _
www.mcpegasus.es.org
'La sintaxis de la función consta de estos argumentos:
'Parte Descripción
'-------------------------------------------------------------------------------------------
'blnVistaPrevia Requerido. Expresión booleana que corresponde al tipo de salida _
del informe, _
True, Vista previa del informe. _
False, Abre el cuadro de diálogo de impresoras.
'strInforme Requerido. Nombre del informe a imprimir.
'intCopias Opcional. Cantidad de copias a imprimir.
'strFrmNombre Opcional. Nombre del formulario donde se utiliza la función, en _
caso de error, nos indica desde donde se produce.
On Error GoTo Err_CapturarError
'Comprobar si existe el nombre del informe.
If Not mc_blnComprobarInforme(strInforme) Then
'No Existe
If Not IsMissing(strFrmNombre) Then
'Si el argumento se ha pasado ...
MsgBox "No existe el informe: " & strInforme _
, vbCritical + vbOKOnly, "McPegasus informa desde " & strFrmNombre
Else
MsgBox "No existe el informe: " & strInforme _
, vbCritical + vbOKOnly, "McPegasus informa."
End If
Else
If blnVistaPrevia = True Then
DoCmd.OpenReport strInforme, acPreview
Else
DoCmd.OpenReport strInforme, acPreview
DoCmd.RunCommand acCmdPrint 'Presentar diálogo de impresoras.
If Not intCopias = 1 Then DoCmd.PrintOut , , , , intCopias - 1
DoCmd.Close acReport, strInforme
End If
End If
Salida:
Exit Function
Err_CapturarError:
Select Case Err.Number
Case 2501 'Se ha cancelado el RunCommand acCmdPrint.
DoCmd.Close acReport, strInforme
Resume Salida
Case Else
'Capturar todos aquellos errores inesperados.
If Not IsMissing(strFrmNombre) Then
'Si el argumento se ha pasado ...
MsgBox Err.Number & " " & Err.Description, vbCritical + vbOKOnly, _
"McPegasus informa desde " & strFrmNombre
Else
MsgBox Err.Number & " " & Err.Description, vbCritical + vbOKOnly, _
"McPegasus informa."
End If
End Select
Resume Salida
End Function
Sub demomc_blnComprobarInforme()
MsgBox mc_blnComprobarInforme("rptBuscar", False)
End Sub
Public Function mc_blnComprobarInforme(strNombreInforme As String, _
Optional blnExiste As Boolean = True) As Boolean
'Actualización: 20/07/2002
'Desarrollador: McPegasus, www.mcpegasus.es.org
'Comprobar si un informe existe en el contenedor de informes o está abierto (cargado).
'Devuelve True en caso de que la comprobación es correcta.
'La sintaxis del Procedimiento o Función, consta de estos argumentos:
'Parte Descripción
'-------------------------------------------------------------------------------------------
'strNombreInforme: Requerido. Nombre del informe a comprobar.
'blnExiste: Opcional. Modo de busqueda del informe. _
True: Buscar si existe en el contenedor de informes _
False: Buscar si está cargado.
On Error GoTo Err_CapturarError
Dim Db As Database
Dim docBucle As Document
If blnExiste Then
Set Db = CurrentDb()
For Each docBucle In Db.Containers!Reports.Documents
If docBucle.Name = strNombreInforme Then
mc_blnComprobarInforme = True
Exit For
End If
Next docBucle
Db.Close
Else
'Fecha Creación: 2000
'Autor: José A. Giménez
If SysCmd(acSysCmdGetObjectState, acReport, strNombreInforme) <> 0 _
Then mc_blnComprobarInforme = True
End If
Salida:
Exit Function
Err_CapturarError:
Select Case Err.Number
Case Else
MsgBox Err.Number & " " & Err.Description, _
vbCritical + vbOKOnly, "McPegasus informa."
End Select
Resume Salida
End Function
(
geocities.com/es/ensolva/Descargas) (
geocities.com/es/ensolva) (
geocities.com/es)