Discriminazione dati diversi passati con openargs

di il
5 risposte

Discriminazione dati diversi passati con openargs

Buonasera.


Richiesta di un consiglio se il mio approccio al problema è ottimale e veloce, oppure ne esistono altri migliori, oppure mi sfugge qualcosa sull'uso di open args.

Da una form dedicata alla ricerca di dati diversi, tramite combobox diverse, passo il dato da ricercare tramite openArgs.

Fino a quando si tratta di un dato da ricercare che va a filtrare un solo campo il problema non sussiste.
Quando invece, devo ricercare il dato su campi diversi mi sono trovato davanti il problema di capire a quale campo deve essere passato il criterio, per poi passare il dato da filtrare.

ho operato in questo modo:

Creo una stringa formata da un identificatore iniziale e il dato da passare.

Ad esempio:

 combobox1 diventa “Avalore”
 combobox2 diventa “Bvalore”

e così via…

Poi nel form load con Mid() e left() separo l'identificatore ed il dato per poi andare a fare la ricerca tramite un select case.

riporto il codice per essere più chiaro.

Creazione della stringa da passare

Private Sub CasellaCombinata0_AfterUpdate()

Dim casella As String

    If IsNull(casella = Me.CasellaCombinata0.Value) Then
        MsgBox ("Inserire un valore valido per la ricerca")
     Exit Sub
    Else

        casella = ("A" & Me.CasellaCombinata0.Value)

    End If

 
 DoCmd.OpenForm "Nome_Form", , , , , , casella

End Sub
Discriminazione del controllo e ricerca

Private Sub Form_Load()

	Dim variabile As String
	Dim controllo As String
	Dim dato As String


		If IsNull(variabile = Me.OpenArgs) Then Exit Sub


			variabile = Me.OpenArgs
			controllo = Left(variabile, 1)
			dato = Mid(variabile, 2)

	Select Case controllo
    	Case "A"
       	 Me.Filter = "Nome_Primo_campo =" & dato  'dato numerico
    	Case "B"
      	 dato = Chr(34) & dato & Chr(34)
       	 Me.Filter = "Nome_secondo_campo =" & dato 'dato stringa
	End Select

	Me.FilterOn = True
	
End Sub

Grazie a tutti

5 Risposte

  • Re: Discriminazione dati diversi passati con openargs

    Puoi fare in diversi modi, quello che citi è uno, e mi pare funzionale.

    Puoi ad esempio comporre una stringa così:

    casella="NomeCampo;ValoreCampo"

    Poi nella Form puoi sfruttare lo SPLIT

    Dim vItems As Variant
    vItems=Split(Me.OpenArgs,";")
    Debug.Print “NomeCampo=” & vItems(0), “ValoreCampo=” & vItems(1)

    Oppure se hai cose più complesse, puoi passare Oggetti veri e propri e sfruttare i POINTER:

    https://1drv.ms/u/s!Are2sGzrs4WCoxCrsDd2Xak5wvn1?e=zXHStP

    Questo esempio non è così semplice dal momento che in VBA i Pointer non sono molto abituali… ma è un'ottimo sistema se si usa programmazione OOP.

  • Re: Discriminazione dati diversi passati con openargs

    Grazie alex, interessante lo uso dello split che non avevo considerato.

    Per quanto riguarda i pointer l avevo esclusi a priori perché primo non sono una volpe ad usarli e secondo mi sembravano “troppo pesanti” da usare per un applicazione, diciamo “banale”.

  • Re: Discriminazione dati diversi passati con openargs

    In realtà usare i Pointer rende tutto MOLTO più svelto… ;-)

  • Re: Discriminazione dati diversi passati con openargs

    05/12/2022 - @Alex ha scritto:


    In realtà usare i Pointer rende tutto MOLTO più svelto… ;-)

    Dovrò decidermi di fare il salto di qualità e mettermi a studiare per bene.

    Toglimi una curiosità che poi approfondirò quando ho un po' di tempo.

    Ma il modulo BasObjectPointer, se non sbaglio rimane uguale anche se copiato in altri database vergini?

  • Re: Discriminazione dati diversi passati con openargs

    Ovviamente si, già adeguato alla compatibilità 32/64Bit

    Giusto per chiarezza…

    Option Explicit
    Option Compare Text
    
    ' API and constants from http://allapi.mentalis.org/apilist/apilist.php
    ' DoCmd.OpenForm "GNTT_PrintImage", , , , , acDialog, GetPointerToObject(object...)
    ' Set cItem = GetObjectFromPointer(Me.OpenArgs)
    #If Win64 Then
        Private Const POINTERSIZE                  As Long = 8
    #Else
        Private Const POINTERSIZE                  As Long = 4
    #End If
    
    #If VBA7 Then
        Private Const ZEROPOINTER As LongPtr = 0
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
        Private Const ZEROPOINTER As Long = 0
        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    #End If
    
    #If VBA7 Then
        Public Function GetPointerToObject(ByRef objThisObject As Object) As LongPtr
            Dim lngThisPointer As LongPtr
    #Else
        Public Function GetPointerToObject(ByRef objThisObject As Object) As Long
            Dim lngThisPointer As Long
    #End If
    
        ' Purpose  : Return the value of a pointer.
        ' Argument : A pointer to an Object.
        ' Author   : ChrisO.
        ' Updated  : 2012-04-18
        CopyMemory lngThisPointer, objThisObject, POINTERSIZE
        GetPointerToObject = lngThisPointer
    
    End Function
    
    #If VBA7 Then
        Public Function GetObjectFromPointer(ByVal lngThisPointer As LongPtr) As Object
    #Else
        Public Function GetObjectFromPointer(ByVal lngThisPointer As Long) As Object
    #End If
        ' Purpose  : Return a pointer to an Object.
        ' Argument : The value of a Pointer.
        ' Author   : ChrisO.
        ' Updated  : 2012-04-18
        
        Dim objThisObject As Object
    
        CopyMemory objThisObject, lngThisPointer, LenB(lngThisPointer)
        Set GetObjectFromPointer = objThisObject
        CopyMemory objThisObject, ZEROPOINTER, LenB(lngThisPointer)
    
    End Function
Devi accedere o registrarti per scrivere nel forum
5 risposte