1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
| Option Compare Database
Option Explicit
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim RsPJ As DAO.Recordset
Dim Tbldef As DAO.TableDef
Dim fld As DAO.Field
Dim Prp As DAO.Property
Dim Compteur As Long
Public Sub CreerChampPJ(NomDeLaTable As String, _
NomDuChamp As String, Optional Légende As String = "")
If Légende = "" Then Légende = NomDuChamp
Set Db = CurrentDb
Set Tbldef = Db.TableDefs(NomDeLaTable)
Set fld = Tbldef.CreateField(NomDuChamp, dbAttachment)
Tbldef.Fields.Append fld
Set fld = Tbldef.Fields(NomDuChamp)
Set Prp = fld.CreateProperty("caption", dbText)
Prp.Value = Légende
fld.Properties.Append Prp
Set Db = Nothing
Set Tbldef = Nothing
Set fld = Nothing
Set Prp = Nothing
End Sub
Public Function isPJ(NomDeLaTable As String, NomDuChamp As String) As Boolean
isPJ = (CurrentDb.TableDefs(NomDeLaTable).Fields(NomDuChamp).Type = dbAttachment)
End Function
Function NomsPJ(stringSQL As String, NomDuChamp As String) As String
Set Db = CurrentDb
Set Rs = Db.OpenRecordset(stringSQL)
If Not Rs.EOF Then
With Rs
Do Until .EOF
Set RsPJ = .Fields(NomDuChamp).Value
With RsPJ
Do Until .EOF
NomsPJ = NomsPJ & RsPJ.Fields("filename") & ";"
.MoveNext
Loop
End With
Set RsPJ = Nothing
.MoveNext
Loop
End With
End If
Set Db = Nothing
Set Rs = Nothing
End Function |
Partager