Access
 sql >> Base de données >  >> RDS >> Access

Jeu d'enregistrements MS-Access et module de classe

Présentation.

Ici, nous allons construire un module de classe pour les tâches de traitement de données, un DAO.Recordset L'objet sera transmis à l'objet de classe personnalisé. Puisqu'il s'agit d'un objet qui passe à notre classe personnalisée, nous avons besoin du Set et Obtenez Paire de procédure de propriété pour affecter et récupérer l'objet ou ses valeurs de propriété.

Nous avons une petite table :Table1 , avec peu d'enregistrements dedans. Voici l'image de la Table1.

Le tableau ci-dessus ne comporte que quatre champs :Desc, Qty, UnitPrice et TotalPrice. Le champ TotalPrice est vide.

  • L'une des tâches de notre module de classe consiste à mettre à jour le champ TotalPrice avec le produit Qty * UnitPrice.
  • Le module de classe a une sous-routine pour trier les données, sur le champ spécifié par l'utilisateur, et vide une liste dans la fenêtre de débogage.
  • Une autre sous-routine crée une copie de la table avec un nouveau nom, après avoir trié les données en fonction du numéro de colonne fourni en paramètre.

Module de classe ClsRecUpdate.

  1. Ouvrez votre base de données Access et ouvrez la fenêtre VBA.
  2. Insérez un module de classe.
  3. Changer sa valeur de propriété de nom en ClsRecUpdate .
  4. Copiez et collez le code suivant dans le module de classe et enregistrez le module :
    Option Compare Database
Option Explicit

Private rstB As DAO.Recordset

Public Property Get REC() As DAO.Recordset
   Set REC = rstB
End Property

Public Property Set REC(ByRef oNewValue As DAO.Recordset)
If Not oNewValue Is Nothing Then
   Set rstB = oNewValue
End If
End Property

Public Sub Update(ByVal Source1Col As Integer, ByVal Source2Col As Integer, ByVal updtcol As Integer)
'Updates a Column with the product of two other columns
Dim col As Integer

col = rstB.Fields.Count

'Validate Column Parameters
If Source1Col > col Or Source2Col > col Or updtcol > col Then
    MsgBox "One or more Column Number(s) out of bound!", vbExclamation, "Update()"
    Exit Sub
End If

'Update Field
On Error GoTo Update_Err
rstB.MoveFirst
Do While Not rstB.EOF
   rstB.Edit
     With rstB
      .Fields(updtcol).Value = .Fields(Source1Col).Value * .Fields(Source2Col).Value
      .Update
      .MoveNext
     End With
Loop

Update_Exit:
rstB.MoveFirst
Exit Sub

Update_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "Update()"
Resume Update_Exit
End Sub

Public Sub DataSort(ByVal intCol As Integer)
Dim cols As Long, colType
Dim colnames() As String
Dim k As Long, colmLimit As Integer
Dim strTable As String, strSortCol As String
Dim strSQL As String
Dim db As Database, rst2 As DAO.Recordset

On Error GoTo DataSort_Err

cols = rstB.Fields.Count - 1
strTable = rstB.Name
strSortCol = rstB.Fields(intCol).Name

'Validate Sort Column Data Type
colType = rstB.Fields(intCol).Type
Select Case colType
    Case 3 To 7, 10
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & " ORDER BY " & strTable & ".[" & strSortCol & "];"
        Debug.Print "Sorted on " & rstB.Fields(intCol).Name & " Ascending Order"

    Case Else
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & ";"

        Debug.Print "// SORT: COLUMN: <<" & strSortCol & " Data Type Invalid>> Valid Type: String,Number & Currency //"
        Debug.Print "Data Output in Unsorted Order"
End Select

Set db = CurrentDb
Set rst2 = db.OpenRecordset(strSQL)

ReDim colnames(0 To cols) As String

'Save Field Names in Array to Print Heading
For k = 0 To cols
   colnames(k) = rst2.Fields(k).Name
Next

'Print Section
Debug.Print String(52, "-")

'Print Column Names as heading
If cols > 4 Then
   colmLimit = 4
Else
   colmLimit = cols
End If
For k = 0 To colmLimit
    Debug.Print colnames(k),
Next: Debug.Print
Debug.Print String(52, "-")

'Print records in Debug window
rst2.MoveFirst
Do While Not rst2.EOF
  For k = 0 To colmLimit 'Listing limited to 5 columns only
     Debug.Print rst2.Fields(k),
  Next k: Debug.Print
rst2.MoveNext
Loop

rst2.Close
Set rst2 = Nothing
Set db = Nothing

DataSort_Exit:
Exit Sub

DataSort_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "DataSort()"
Resume DataSort_Exit

End Sub

Public Sub TblCreate(Optional SortCol As Integer = 0)
Dim dba As DAO.Database, tmp() As Variant
Dim tbldef As DAO.TableDef
Dim fld As DAO.Field, idx As DAO.Index
Dim rst2 As DAO.Recordset, i As Integer, fldcount As Integer
Dim strTable As String, rows As Long, cols As Long

On Error Resume Next

strTable = rstB.Name & "_2"
Set dba = CurrentDb

On Error Resume Next
TryAgain:
Set rst2 = dba.OpenRecordset(strTable)
If Err > 0 Then
  Set tbldef = dba.CreateTableDef(strTable)
  Resume Continue
Else
  rst2.Close
  dba.TableDefs.Delete strTable
  dba.TableDefs.Refresh
  GoTo TryAgain
End If
Continue:
On Error GoTo TblCreate_Err

fldcount = rstB.Fields.Count - 1
ReDim tmp(0 To fldcount, 0 To 1) As Variant

'Save Source File Field Names and Data Type
For i = 0 To fldcount
    tmp(i, 0) = rstB.Fields(i).Name: tmp(i, 1) = rstB.Fields(i).Type
Next
'Create Fields and Index for new table
For i = 0 To fldcount
   tbldef.Fields.Append tbldef.CreateField(tmp(i, 0), tmp(i, 1))
Next
'Create index to sort data
Set idx = tbldef.CreateIndex("NewIndex")
With idx
   .Fields.Append .CreateField(tmp(SortCol, 0))
End With
'Add Tabledef and index to database
tbldef.Indexes.Append idx
dba.TableDefs.Append tbldef
dba.TableDefs.Refresh

'Add records to the new table
Set rst2 = dba.OpenRecordset(strTable, dbOpenTable)
rstB.MoveFirst 'reset to the first record
Do While Not rstB.EOF
   rst2.AddNew 'create record in new table
    For i = 0 To fldcount
        rst2.Fields(i).Value = rstB.Fields(i).Value
    Next
   rst2.Update
rstB.MoveNext 'move to next record
Loop
rstB.MoveFirst 'reset record pointer to the first record
rst2.Close

Set rst2 = Nothing
Set tbldef = Nothing
Set dba = Nothing

MsgBox "Sorted Data Saved in " & strTable

TblCreate_Exit:
Exit Sub

TblCreate_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "TblCreate()"
Resume TblCreate_Exit

End Sub

La propriété rstB est déclarée en tant qu'objet DAO.Recordset.

Grâce à la procédure Set Property, un objet recordset peut être passé à la classe ClsRecUpdate Objet.

La mise à jour() La sous-routine accepte les nombres à trois colonnes (numéros de colonne basés sur 0) comme paramètres pour calculer et mettre à jour la troisième colonne de paramètres avec le produit de la première colonne * deuxième colonne.

Le DataSort() subroutine Trie les enregistrements par ordre croissant en fonction du numéro de colonne passé en paramètre.

Le type de données de la colonne de tri doit être Nombre ou Devise ou Chaîne. Les autres types de données sont ignorés.

Une liste des enregistrements sera affichée dans la fenêtre de débogage. La liste des champs sera limitée à cinq champs seulement, si la source d'enregistrement en contient plus, le reste des champs est ignoré.

Le TblCreate() La sous-routine triera les données, en fonction du numéro de colonne passé en paramètre, et créera une table avec un nouveau nom. Le paramètre est facultatif, si un numéro de colonne n'est pas passé en tant que paramètre, le tableau sera trié sur les données de la première colonne si le type de données de la colonne est un type valide. Le nom d'origine de la table sera modifié et ajouté avec la chaîne "_2" au nom d'origine. Si le nom de la table source est Table1 alors le nouveau nom de table sera Table1_2 .

Le programme de test pour ClsUpdate.

Testons le ClsRecUpdate Objet de classe avec un petit programme.

Le code du programme de test est donné ci-dessous :

Public Sub DataProcess()
Dim db As DAO.Database
Dim rstA As DAO.Recordset

Dim R_Set As ClsRecUpdate
Set R_Set = New ClsRecUpdate

Set db = CurrentDb
Set rstA = db.OpenRecordset("Table1", dbOpenTable)

'send Recordset Object to Class Object
Set R_Set.REC = rstA

'Update Total Price Field
Call R_Set.Update(1, 2, 3) 'col3=col1 * col2

'Sort Ascending Order on UnitPrice column & Print in Debug Window
Call R_Set.DataSort(2)

'Create New Table Sorted on UnitPrice in Ascending Order
Call R_Set.TblCreate(2) 
Set rstA = Nothing
Set db = Nothing
xyz:
End Sub

Vous pouvez passer n'importe quel jeu d'enregistrements pour tester l'objet de classe.

Vous pouvez transmettre n'importe quel numéro de colonne pour mettre à jour une colonne particulière. Les numéros de colonne ne sont pas nécessairement des numéros consécutifs. Mais le troisième paramètre de numéro de colonne est la colonne cible à mettre à jour. Le premier paramètre est multiplié par le deuxième paramètre de colonne pour arriver à la valeur de résultat à mettre à jour. Vous pouvez modifier le code du module de classe pour effectuer toute autre opération que vous souhaitez effectuer sur la table.

La sélection du type de données de la colonne de tri doit être Chaîne, Numérique ou Type de devise uniquement. Les autres types sont ignorés. Les numéros de colonne du jeu d'enregistrements sont basés sur 0, ce qui signifie que le numéro de la première colonne est 0, la deuxième colonne est 1, et ainsi de suite.

Liste de tous les liens sur ce sujet.

  1. Module de classe MS-Access et VBA
  2. Tableaux d'objets de classe MS-Access VBA
  3. Classe de base MS-Access et objets dérivés
  4. Classe de base VBA et objets dérivés-2
  5. Classe de base et variantes d'objets dérivés
  6. Ensemble d'enregistrements et module de classe MS-Access
  7. Accéder au module de classe et aux classes wrapper
  8. Transformation des fonctionnalités de la classe wrapper
  9. Ms-Access et les bases des objets de collection
  10. Module de classe MS-Access et objet de collection
  11. Enregistrements de table dans l'objet et le formulaire de collection
  12. Principes de base des objets de dictionnaire
  13. Principes de base des objets de dictionnaire -2
  14. Tri des clés d'objet et des éléments du dictionnaire
  15. Afficher les enregistrements du dictionnaire au formulaire
  16. Ajouter des objets de classe en tant qu'éléments de dictionnaire
  17. Mettre à jour l'élément du dictionnaire d'objets de classe sur le formulaire