I respond to mysqlf because I've got a solution from other forum
Could you please edit your post with the URL referencing your solution ?
Thanks.
JPL
I respond to mysqlf because I've got a solution from other forum
REM Edit mode
Const dbEditNone = 0
Const dbEditInProgress = 1
Const dbEditAdd = 2
[...]
Set A2BCtrlForm = _oTAdaptA2BForm.Controls("SubFormRecords", "subform)"
oA2BFormRecords = A2BCtrlForm.Form
[...]
Set ocOptionGroup = oA2BFormRecords.OptionGroup("RadioButtonFormatCote")
[...]
an OptionGroup is an artificial entity (defined in MSAccess and subsequently in Access2Base)
The Refresh method immediately updates the records in the underlying record source for a specified form to reflect changes made to the data by you or other users in a multiuser environment.
L'erreur #1 (Une exception s'est produite : ) s'est produite à la ligne 534 dans SubForm.Refresh
[...]
[533] Case UCase("RecordSource")
[534] If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
[535] DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
[536] DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND
[537] DatabaseForm.Filter = ""
[538] DatabaseForm.reload()
[...]
could you give me a snippet code to display how to update a Form already in changed state ?
DoCmd.RunCommand("RecSave")
If Len(pvValue) > _Precision Then Goto Trace_Error_Length
Function BankersRound(ByRef pDecimals As Integer)
'Rounds pValue to pDecimals using the “bankers rounding”: rounding to the nearest even number.
'Rounds a value to a given number of decimals using the “bankers rounding”, that is rounding to the nearest even number.
'Input:
'-- pValue: the value to round.
'-- pDecimals: the number of decimals for the rounding.
'Output: The rounded number.
'Usage
'BankersRound(1,5, 0) -> 2
'BankersRound(2,5, 0) -> 2
[...]
Function BankersRound(ByRef pValue As Double, pDecimals As Integer) As Double
Rounds a value to a given number of decimals using the “bankers rounding”, that is rounding to the nearest even number.
Input
• pValue: the value to round.
• pDecimals: the number of decimals for the rounding.
Output
The rounded number.
Usage
BankersRound(1.5, 0) → 2
BankersRound(2.5, 0) → 2
See also Round().
L'erreur #35 (Sous-procédure ou procédure fonction non définie) s'est produite à la ligne 606 dans Recordset.GetRows
Author ........: Patrick GELIN
' Modified.......: 23/06/2019
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Sub DBOpen(Optional poEvent As Object)
If GlobalScope.BasicLibraries.hasByName("Access2Base") Then
GlobalScope.BasicLibraries.loadLibrary("Access2Base")
End If
Call Application.OpenConnection(ThisDatabaseDocument)
End Sub
Sub DBClose(Optional poEvent As Object)
Call CloseConnection()
End Sub
Public Sub TEST_A2BGETROWS(oApplication As Object, oDebug As Object)
const dbReadOnly = 4
Dim orsRecords As Object
Dim vDataBlock() As Variant
Dim t0, t1 As Long
On local error goto Erreur
DBOpen()
Set orsRecords = Application.CurrentDb().OpenRecordSet("SELECTALLNOTICES",,, dbReadOnly)
with orsRecords
Do while Not .EOF()
t0 = GetSystemTicks
Set vDataBlock = .GetRows(200)
t1 = GetSystemTicks
oDebug.Trace(Name, "vDataBlock(" & i & ") : " & UBound(vDataBlock) - LBound(vDataBlock) & " lignes, " & t1-t0 & " ticks")
Loop
.mClose()
End With
DBClose()
Exit_Sub:
Exit Sub
Erreur:
TraceError("ERROR", Err, Name, Erl)
DBClose()
Stop
End Sub
J'utilise la dernière version 0.9.1 de Acess2Base.
Il me semle comprendre que maintenant les controls en boite de dialogue seraient DATAWARE ?
il semble y avoir un problème pour localiser l'appel à la méthode _getResultSetColumnValue déclarée privée dans un autre module ...
CREATE TABLE PUBLIC.PUBLIC.DOCLESNOTICES (
ID BIGINT NOT NULL IDENTITY,
TITRE VARCHAR(255) DEFAULT 'Nouveau document ...',
DTEXPIRATION DATE,
DTCREATION TIMESTAMP DEFAULT LOCALTIMESTAMP NOT NULL,
DTMODIFICATION TIMESTAMP DEFAULT LOCALTIMESTAMP NOT NULL,
DTIMPORT TIMESTAMP,
MODELCOTE VARCHAR(50),
DTEDITION VARCHAR(50),
RESUME VARCHAR(2048),
AUTEURS VARCHAR(200),
"COLLATION" VARCHAR(200),
EDITEURS VARCHAR(200),
COLLECTION VARCHAR(150),
FKNOTICEPERE BIGINT,
ISBN VARCHAR(40),
ISSN VARCHAR(10),
CODEBARRE VARCHAR(30),
MENTIONEDITION VARCHAR(100),
CENTREINTERETS VARCHAR(512),
MOTSCLES VARCHAR(100),
FKFONDS BIGINT,
TYPENOTICE VARCHAR(50) DEFAULT 'NOTICE PRINCIPALE' NOT NULL,
REFERENCE VARCHAR(100),
SUPPORT VARCHAR(30),
NATURE VARCHAR(100),
COLLECTIONNUM VARCHAR(30),
TYPENATURE VARCHAR(30),
CONSTRAINT SYS_PK_10350 PRIMARY KEY (ID),
CONSTRAINT DOCLESNOTICES_DOCLESNOTICES_FK FOREIGN KEY (FKNOTICEPERE) REFERENCES PUBLIC.PUBLIC.DOCLESNOTICES(ID) ON DELETE CASCADE ON UPDATE CASCADE,
CONSTRAINT DOCLESNOTICES_FK FOREIGN KEY (FKFONDS) REFERENCES PUBLIC.PUBLIC.AUTLESFONDSDOCUMENTAIRES(ID) ON DELETE CASCADE ON UPDATE CASCADE
);
CREATE INDEX SYS_IDX_DOCLESNOTICES_DOCLESNOTICES_FK_10359 ON PUBLIC.PUBLIC.DOCLESNOTICES (FKNOTICEPERE);
CREATE INDEX SYS_IDX_DOCLESNOTICES_FK_10361 ON PUBLIC.PUBLIC.DOCLESNOTICES (FKFONDS);
CREATE UNIQUE INDEX SYS_IDX_SYS_PK_10350_10354 ON PUBLIC.PUBLIC.DOCLESNOTICES (ID);
I'm asking myself if access2base could help to manage events intopseudo code objectclass module
vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1)
vMatrix(i, lSize) = Utils._getResultSetColumnValue(RowSet, i + 1)
You have only to replace call to _getResultSetColumnValue into the line 606 into RecordSet
GetRows result use 2D array format
What about memory cache into Uno RecordSet ?
Private _TMTXFlagCore As Boolean 'True si le flag est levé (verrou interne posé)
Private _TMTXVerrouille As Boolean
Private _TMTXLibre As Boolean
Private _TMTXFolioteur As Object
Rem ===========================================================================
Rem CONSTRUCTEUR / DESCTRUCTEUR
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: Class_Initialize
' Description ...:
' Parameters ....:
' Syntax ........: TransiterEtat(NouvelEtat)
' NouvelEtat - Etat à atteindre
' Return values .: Success - void
' Failure - sets @error
' |1 - NouvelEtat n'est pas un etat valide
' |2 - La transition n'est pas autorisée
' Author ........:
' Modified.......: - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Class_Initialize()
On local error goto Erreur
_TMTXVerrouille = true
_TMTXLibre = false
_TMTXStep = 400
_TMTXChienMax = 20000
_TMTXoDictFlags = FabriquerTDictionnaire(Name & "::TMTXoDictFlags")
_TMTXFlagCore = _TMTXLibre
_TMTXLockInTail = 0
_TMTXLockOutTail = 0
_TMTXLockedCounter = 0
Exit_Sub:
On error resume next
Exit Sub
Erreur:
TraceError("ERROR", Err, Name, Erl)
Stop
End Sub
' #PROCEDURE# ==================================================================
' Name...........: Class_Terminate()
' Description ...:
' Parameters ....:
' Syntax ........: TransiterEtat(NouvelEtat)
' NouvelEtat - Etat à atteindre
' Return values .: Success - void
' Failure - sets @error
' |1 - NouvelEtat n'est pas un etat valide
' |2 - La transition n'est pas autorisée
' Author ........:
' Modified.......: - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Class_Terminate()
Dim It As Object
Set It = _TMTXoDictFlags.Iterateur
While It.Suivant
It.Value = false
Wend
Dispose(_TMTXoDictFlags)
End Sub
Rem ===========================================================================
Rem PROPRIETES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: ChienMax
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Let ChienMax(chienmax As Long)
_TMTXChienMax = chienmax
End Property
' #PROCEDURE# ==================================================================
' Name...........: Counter
' Description ...: Le nombre de verrous posés.
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......:
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Get Counter As Long
Counter = _TMTXLockedCounter
End Property
' #PROCEDURE# ==================================================================
' Name...........: StepWait
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Let StepWait(milliseconds As Long)
_TMTXStep = milliseconds
End Property
' #PROCEDURE# ==================================================================
' Name...........: NBElements
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Get NBElements As Long
NBElements = _TMTXoDictFlags.NBElements
End Property
Public Property Let Titre(untitre As String)
_TMTXoDictFlags.Titre = unTitre
End Property
Public Property Get Titre As String
Titre = _TMTXoDictFlags.Titre
End Property
Rem ===========================================================================
Rem METHODES PRIVEES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: _Verrouiller
' Portée.........: PRIVE
' Description ...: Verrouille l'utilisation interne de l'objet Mutex (aucune autre
' méthode ne peut être appelée, de façon à garantir l'intégrité
' de l'état interne du Mutex). Le Mutex est un singleton, donc
' une ressource partagée qui ne oblige un accès séquentiel. Le
' temps d'attente est fixé par _TMTXStep * ChienDeGarde. Pendant le
' temps _TMTXStep le thread en attente est complètement endormi...
' Parameters ....: label : Un label assoccié au verrouillage (utile pour le fichier
' de logs)
' Syntax ........:
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......: En cas d'abandon le trhead est stoppé, ce qui pourrait poser
' problème si l'évènement n'est pas reproduit quelques temps
' après.
' Related .......: Verouiller : Verouille une méthode externe au mutex.
' Link ..........:
' Example .......: Verrouiller("blocage par appelant ####")
Private Sub _Verrouiller(CallNumber As Long)
Dim ChienDeGarde As integer
On local error goto Erreur
Dim oDebug As Object
oDebug = FabriquerTApplication.Debug
'Si le mutex est déjà verrouillé en interne alors il faut attendre tant que
'le chien de garde l'autorise ...
_TMTXLockInTail = _TMTXLockInTail + 1
ChienDeGarde = 0
While _TMTXFlagCore 'AND (ChienDeGarde < _TMTXChienMax)
oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") " & _TMTXLockInTail & " verrouillages en cours ...", TRACE_ALL)
Wait _TMTXStep
'ChienDeGarde = ChienDeGarde + _TMTXStep
Wend
'If ChienDeGarde = _TMTXChienMax Then
'Attente trop longue : Abandon de la demande et stop du flux programmatique
'oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") a échoué sur chien de garde ...", TRACE_ALL)
'_TMTXLockInTail = _TMTXLockInTail - 1
'Stop
'EndIf
Exit_Sub:
On error resume next
'On pose le verrouillage interne...
_TMTXFlagCore = _TMTXVerrouille
oDebug.Trace(Name, "+++ Verrouillage interne(" & CallNumber & ") activé +++", TRACE_ALL)
Exit Sub
Erreur:
_Liberer(CallNumber)
oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") a échoué sur erreur interne ...", TRACE_ALL)
TraceError("ERROR", Err, Name, Erl)
Stop
End Sub
' #PROCEDURE# ==================================================================
' Name...........: _Liberer
' Portée.........: PRIVE
' Description ...: Libère le verrou interne du Mutex
' Parameters ....: label : Un label assoccié au verrouillage (utile pour le fichier
' de logs)
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........: voir "_Verrouiller(label As String)"
' Example .......:
Private Sub _Liberer(CallNumber As Long)
On local error goto Erreur
_TMTXFlagCore = _TMTXLibre
_TMTXLockInTail = IIf(_TMTXLockInTail - 1 <= 0, 0, _TMTXLockInTail - 1)
Dim oDebug As Object
oDebug = FabriquerTApplication.Debug
oDebug.Trace(Name, "--- Verrouillage interne (" & CallNumber & ") libéré ---", TRACE_ALL)
Exit_Sub:
On error resume next
Exit Sub
Erreur:
TraceError("ERROR", Err, Name, Erl)
Stop
End Sub
' #PROCEDURE# ==================================================================
' Name...........: Trace
' Portée.........:
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Trace(oDebug As Object)
oDebug.Trace(Name, "++++++++++++++++++++ "& Name & " ++++++++++++++++++++", TRACE_ALL)
oDebug.Trace(Name, "ChienMax ...................... : " & ChienMax & " ms", TRACE_ALL)
oDebug.Trace(Name, "Delait d'attente .............. : " & _TMTXStep & " ms", TRACE_ALL)
oDebug.Trace(Name, "", TRACE_ALL)
oDebug.Trace(Name, "Total des verrous posés ....... : " & _TMTXLockedCounter, TRACE_ALL)
oDebug.Trace(Name, "Appels internes en cours ...... : " & _TMTXLockInTail, TRACE_ALL)
oDebug.Trace(Name, "Appels externes en cours ..... : " & _TMTXLockOutTail, TRACE_ALL)
_TMTXoDictFlags.Trace(oDebug)
oDebug.Trace(Name, "-------------------- "& Name & " --------------------", TRACE_ALL)
End Sub
Rem ===========================================================================
Rem METHODES PUBLIQUES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: Create
' Portée.........: PUBLIQUE
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 13/11/2019
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Sub Create(Folioteur As Object)
If IsNull(Folioteur) Then Err = 14
On local error Goto Erreur
_TMTXFolioteur = Folioteur
_TMTXFolioteur.Reset("MUTEX")
Exit_Sub:
On error resume next
Exit Sub
Erreur:
TraceError("ERROR", Err, Name, Erl)
Stop
End Sub
' #PROCEDURE# ==================================================================
' Name...........: Verrouiller
' Portée.........: PUBLIQUE
' Description ...: Pose d'un verrou pour éviter un appel réentrant sur la méthode
' appelante.
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......: Le verrou est posé avec un flag true dans le dictionnaire.
' Related .......:
' Link ..........:
' Example .......:
Public Function Verrouiller(sFlag As String) As Boolean
Dim ChienDeGarde As Integer
Dim lIndice As Long
Dim Duolet As Object
Dim CallNumber As Long
If NOT Assigned(sFlag) Then Err = 14
On local error goto Erreur
CallNumber = _TMTXFolioteur.Execute("MUTEX")
_TMTXLockOutTail = _TMTXLockOutTail + 1
Dim oDebug As Object
oDebug = FabriquerTApplication.Debug
_Verrouiller(CallNumber)
Patrick GELIN
'Si le flag du verrou n'existe pas alors il est ajouté à la
'collection courrante directement en mode réservation.
If NOT _TMTXoDictFlags.Contient(sFlag, lIndice) Then
_TMTXoDictFlags.Ajouter(sFlag, _TMTXVerrouille)
Goto Exit_Function
EndIf
Set Duolet = _TMTXoDictFlags.DuoletAtIndice(lIndice)
'Attente de la libération du verrou externe ...
ChienDeGarde = 0
While Duolet.Value AND (ChienDeGarde <= _TMTXChienMax)
oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & CallNumber & ") " & _TMTXLockOutTail & "appel-s en cours ...", TRACE_ALL)
Trace(oDebug)
wait _TMTXStep
ChienDeGarde = ChienDeGarde + _TMTXStep
Wend
If (ChienDeGarde = _TMTXChienMax) Then
Liberer(sFlag)
_liberer(CallNumber)
oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & "." & CallNumber & ") échouée (sur chien de garde) ...", TRACE_ALL)
Verrouiller = False
Exit Function
EndIf
Exit_Function:
On error resume next
Duolet.Value = _TMTXVerrouille
_TMTXLockedCounter = _TMTXLockedCounter + 1
Verrouiller = True
_Liberer(CallNumber)
oDebug.Trace(Name, "+++ Verrouillage externe(" & sFlag & "." & CallNumber & ") activé +++", TRACE_ALL)
Exit Function
Erreur:
Liberer(sFlag)
_liberer(CallNumber)
oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & "." & CallNumber & ") échouée (sur erreur interne=) ...", TRACE_ALL)
TraceError("ERROR", Err, Name, Erl)
Stop
End Function
' #PROCEDURE# ==================================================================
' Name...........: Liberer
' Description ...: Libère le verrou nommé en paramètre.
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Sub Liberer(sFlag As String)
Dim Duolet As Object
Dim lIndice As Long
On local error goto Erreur
If not _TMTXoDictFlags.Contient(sFlag, lIndice) Then
Goto Exit_sub
EndIf
Set Duolet = _TMTXoDictFlags.DuoletAtIndice(lIndice)
Duolet.Value = _TMTXLibre
_TMTXLockOutTail = _TMTXLockOutTail - 1
Dim oDebug As Object
oDebug = FabriquerTApplication.Debug
oDebug.Trace(Name, "--- Verrouillage externe " & sFlag & " libéré ---", TRACE_ALL)
Exit_Sub:
On error resume next
Exit Sub
Erreur:
TraceError("ERROR", Err, Name, Erl)
Stop
End Sub
' #PROCEDURE# ==================================================================
' Name...........: EstLibre
' Description ...: Vrai si le verrou nommé en paramètre est actif.
' (valeur false dans le dictionnaire)
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Function EstLibre(sFlag As String) As Boolean
Dim result As Boolean
Dim lIndice As Long
On local error goto Erreur
result = true
If _TMTXoDictFlags.Contient(sFlag, lIndice) Then
result = NOT _TMTXoDictFlags.ValueAtIndice(lIndice)
EndIf
EstLibre = result
Exit_Function:
On error resume next
Exit Function
Erreur:
TraceError("ERROR", Err, Name, Erl)
Stop
End Function
I've got a lot of problems with reantrancy events when I open a form.
Users browsing this forum: No registered users and 2 guests