Could you please edit your post with the URL referencing your solution ?I respond to mysqlf because I've got a solution from other forum
Thanks.
JPL
Could you please edit your post with the URL referencing your solution ?I respond to mysqlf because I've got a solution from other forum
Code: Select all
REM Edit mode
Const dbEditNone = 0
Const dbEditInProgress = 1
Const dbEditAdd = 2
Code: Select all
[...]
Set A2BCtrlForm = _oTAdaptA2BForm.Controls("SubFormRecords", "subform)"
oA2BFormRecords = A2BCtrlForm.Form
[...]
Set ocOptionGroup = oA2BFormRecords.OptionGroup("RadioButtonFormatCote")
[...]
but there is also a group property with Radios Buttons and It need to use again same name as radios buttons in order to success. You can have a look at property "Nom du groupe" (Group Name) into capture attachment... (It's LibreOffice 5.2.7.2).an OptionGroup is an artificial entity (defined in MSAccess and subsequently in Access2Base)
It looks like a requery not a save ...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.
SubForm code is :L'erreur #1 (Une exception s'est produite : ) s'est produite à la ligne 534 dans SubForm.Refresh
Code: Select all
[...]
[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()
[...]
I'm not sure about what you intend to do exactly ? Do you want to update the form or the database ?could you give me a snippet code to display how to update a Form already in changed state ?
Code: Select all
DoCmd.RunCommand("RecSave")
Code: Select all
If Len(pvValue) > _Precision Then Goto Trace_Error_Length
Code: Select all
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
[...]
Code: Select all
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().
Le code source est ci-dessous :L'erreur #35 (Sous-procédure ou procédure fonction non définie) s'est produite à la ligne 606 dans Recordset.GetRows
Code: Select all
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
This version is completely outdated. Which version do you really use ? (Check the first lines of the acConstants module in the library).J'utilise la dernière version 0.9.1 de Acess2Base.
I'm not aware at all that controls in dialogs could be data aware ?Il me semle comprendre que maintenant les controls en boite de dialogue seraient DATAWARE ?
Indeed this is what the error message means. Anyway the Private status of the function declaration is ignored by Basic.il semble y avoir un problème pour localiser l'appel à la méthode _getResultSetColumnValue déclarée privée dans un autre module ...
Code: Select all
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);
Well, events are processed by a specific class module ?? Or, I don't understand your request.I'm asking myself if access2base could help to manage events intopseudo code objectclass module
Code: Select all
vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1)
Code: Select all
vMatrix(i, lSize) = Utils._getResultSetColumnValue(RowSet, i + 1)
I don't understand why the module name (Utils) should be added but I'm ready to make the change.You have only to replace call to _getResultSetColumnValue into the line 606 into RecordSet
Indeed this is the behaviour of VBA's GetRows(). Hence this design choice.GetRows result use 2D array format
There is a cache mechanism indeed. A number of rows are fetched from the database at once: 50 by default for HSQLDB. But this operation only copies the concerned data in some memory buffer. However this does not prevent the application developer to get rows and fields one by one from there.What about memory cache into Uno RecordSet ?
Code: Select all
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
Code: Select all
I've got a lot of problems with reantrancy events when I open a form.