Attribute VB_Name = "GLAccountsExcelApi" Option Explicit ' Excel API POC for GL ACCOUNTS FUNCTIONS. ' ' Setup: ' 1. Install PostgreSQL ODBC driver. ' 2. Apply notes/accounting/excel_api/gl_accounts_sql_poc.sql. ' 3. Open Excel in safe mode: double-clic sur Ouvrir_Excel_SafeMode.bat ' 4. Developer > Visual Basic > File > Import File > importe ce .bas. ' 5. Run SetManualCalculation once (sets xlCalculationManual). ' ' Usage (2 modes au choix): ' Mode formule : tape =GetAccountAmount("ICT TRADING","20011","USD","2026-05-13") ' dans n'importe quelle cellule, puis F9 pour recalculer. ' Mode macro : remplis Setup!B6:B9, lance RefreshGLApi. Private Const GL_API_CONNECTION_STRING As String = "DSN=tradon;" Private gConnection As Object Private gCache As Object ' ---- Connection helpers ---- Private Function ApiCache() As Object If gCache Is Nothing Then Set gCache = CreateObject("Scripting.Dictionary") End If Set ApiCache = gCache End Function Private Function DbConnection() As Object If gConnection Is Nothing Then Set gConnection = CreateObject("ADODB.Connection") gConnection.ConnectionString = GL_API_CONNECTION_STRING gConnection.ConnectionTimeout = 5 gConnection.CommandTimeout = 30 gConnection.Open ElseIf gConnection.State = 0 Then gConnection.Open End If Set DbConnection = gConnection End Function Private Sub ResetDbConnection() On Error Resume Next If Not gConnection Is Nothing Then If gConnection.State <> 0 Then gConnection.Close End If Set gConnection = Nothing On Error GoTo 0 End Sub Public Sub ClearGLApiCache() If Not gCache Is Nothing Then gCache.RemoveAll End Sub Public Sub CloseGLApiConnection() If Not gConnection Is Nothing Then If gConnection.State <> 0 Then gConnection.Close End If Set gConnection = Nothing End Sub ' ---- Setup ---- ' Vide le cache pour forcer un rafraichissement DB au prochain recalcul. ' Utile si les donnees ont change cote serveur. Public Sub ForceRefresh() ClearGLApiCache Application.Calculate End Sub ' ---- Mode macro : RefreshGLApi ---- ' Lit Setup!B6:B9, interroge la DB, ecrit les valeurs dans Functions!C6:C13. Public Sub RefreshGLApi() Dim wsSetup As Worksheet Dim wsFunctions As Worksheet On Error Resume Next Set wsSetup = ThisWorkbook.Worksheets("Setup") Set wsFunctions = ThisWorkbook.Worksheets("Functions") On Error GoTo 0 If wsSetup Is Nothing Then MsgBox "Feuille 'Setup' introuvable.", vbExclamation Exit Sub End If If wsFunctions Is Nothing Then MsgBox "Feuille 'Functions' introuvable.", vbExclamation Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False Dim company As String Dim account As String Dim currencyIso As String Dim valueDate As Variant company = CStr(wsSetup.Range("B6").Value) account = CStr(wsSetup.Range("B7").Value) currencyIso = CStr(wsSetup.Range("B8").Value) valueDate = wsSetup.Range("B9").Value ClearGLApiCache On Error GoTo RefreshError wsFunctions.Range("C6").Value = RunQuery("get_account_base_amount", company, account, currencyIso, valueDate) wsFunctions.Range("C7").Value = RunQuery("get_account_real_base_amount", company, account, currencyIso, valueDate) wsFunctions.Range("C8").Value = RunQuery("get_account_amount", company, account, currencyIso, valueDate) wsFunctions.Range("C9").Value = RunQuery("get_account_abbr", company, account, currencyIso, valueDate) wsFunctions.Range("C10").Value = RunQuery("get_account_name", company, account, currencyIso, valueDate) wsFunctions.Range("C11").Value = RunQuery("get_account_contact", company, account, currencyIso, valueDate) wsFunctions.Range("C12").Value = RunQuery("get_account_contact_code", company, account, currencyIso, valueDate) wsFunctions.Range("C13").Value = RunQuery("get_account_contact_name", company, account, currencyIso, valueDate) CloseGLApiConnection GoTo RefreshDone RefreshError: MsgBox "RefreshGLApi error: " & Err.Description, vbExclamation RefreshDone: Application.ScreenUpdating = True Application.EnableEvents = True End Sub ' ---- Core SQL runner ---- Private Function RunQuery( _ ByVal functionName As String, _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant On Error GoTo ErrorHandler Dim key As String key = functionName & "|" & CStr(companyKey) & "|" & CStr(accountCode) _ & "|" & CStr(currencyIso) & "|" & SqlDate(valueDate) If ApiCache.Exists(key) Then RunQuery = ApiCache(key) Exit Function End If Dim sql As String sql = "select excel_api." & functionName & "('" _ & SqlText(companyKey) & "','" _ & SqlText(accountCode) & "','" _ & SqlText(currencyIso) & "','" _ & SqlDate(valueDate) & "'::date)" Dim rs As Object Dim attempt As Integer RetryQuery: Set rs = CreateObject("ADODB.Recordset") rs.Open sql, DbConnection, 0, 1 If rs.EOF Or IsNull(rs.Fields(0).Value) Then RunQuery = Empty Else RunQuery = rs.Fields(0).Value End If rs.Close ApiCache.Add key, RunQuery Exit Function ErrorHandler: If attempt = 0 Then attempt = 1 If Not rs Is Nothing Then If rs.State <> 0 Then rs.Close End If ResetDbConnection Resume RetryQuery End If RunQuery = "#ERR " & Err.Number & ": " & Err.Description End Function Private Function SqlDate(ByVal valueDate As Variant) As String SqlDate = Format$(CDate(valueDate), "yyyy-mm-dd") End Function Private Function SqlText(ByVal value As Variant) As String SqlText = Replace(CStr(value), "'", "''") End Function ' ---- UDF formulas (mode formule) ---- ' Utilisation : =GetAccountAmount("ICT TRADING", B7, B8, B9) ' Puis F9 pour recalculer. Le cache evite les appels DB redondants. Public Function GetAccountBaseAmount( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountBaseAmount = RunQuery("get_account_base_amount", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountRealBaseAmount( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountRealBaseAmount = RunQuery("get_account_real_base_amount", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountAmount( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountAmount = RunQuery("get_account_amount", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountAbbr( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountAbbr = RunQuery("get_account_abbr", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountName( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountName = RunQuery("get_account_name", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountContact( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountContact = RunQuery("get_account_contact", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountContactCode( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountContactCode = RunQuery("get_account_contact_code", companyKey, accountCode, currencyIso, valueDate) End Function Public Function GetAccountContactName( _ ByVal companyKey As Variant, _ ByVal accountCode As Variant, _ ByVal currencyIso As Variant, _ ByVal valueDate As Variant) As Variant GetAccountContactName = RunQuery("get_account_contact_name", companyKey, accountCode, currencyIso, valueDate) End Function