262 lines
8.6 KiB
QBasic
262 lines
8.6 KiB
QBasic
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
|