lunes, 3 de septiembre de 2018

VBA Access. Función para visualizar o imprimir informes que se encuentran en un archivo externo. Consigue evitar error si el informe ya está abierto.

#If Win64 = 1 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Public Function ImprimirReport(ByVal sPathFileReports As String, ByVal Report As String, Optional ByVal OpenArgs As String = "", Optional VistaPrevia As Boolean = False) As Boolean
On Error GoTo Error:
    Dim bReintento As Boolean
    bReintento = False
       
    Dim objAccess As Access.Application
    Set objAccess = GetObject(sPathFileReports)
   
    If VistaPrevia Then
        objAccess.Visible = True
    Else
        objAccess.Visible = False
    End If
   
Retry:
    objAccess.DoCmd.Close acReport, Report
    objAccess.DoCmd.OpenReport Report, IIf(VistaPrevia, acViewPreview, acViewNormal), , , , OpenArgs
   
    If Not VistaPrevia Then
        Sleep 10
       
        objAccess.DoCmd.Close acReport, Report
        objAccess.Application.Quit
        Set objAccess = Nothing
    End If
   
    ImprimirReport = True
   
Exit Function
    Resume
Error:
    If Not bReintento And Err.Number = 2455 Then
        'Si el archivo de reports ya se encuentra abierto,
        'no es posible cambiar la propiedad Visible y lanza el error 2455
        'continuar desde etiqueta Retry.
        'USAMOS EL FLAG bReintento PARA REINTENTAR SOLO 1 VEZ.
        bReintento = True
        GoTo Retry
    End If

    If Not objAccess Is Nothing Then objAccess.Application.Quit
    Set objAccess = Nothing
    ImprimirReport = False
    MsgBox Err.Number & ": " & Err.Description
End Function

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...