[Toutes versions] Ajustement automatique des colonnes [Résolu]

[azertix]

Bonjour.
Petite question peu utile mais pratique.
Peut-on en VBA, ajuster les colonnes des tables dans Access à la manière d'Autofit dans Excel ?

Merci d'avance à ceux qui prendront le temps de me lire.

[LedZeppII]

Bonsoir,

Voila ce qui d'après mes connaissances s'en approche le plus :

Code :

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
Private Sub cmdLargeurAutoTable1_Click()
Dim strTbl As String
Dim fm As Access.Form, ctl As Access.Control
Dim bytCtlType As Byte
 
On Error GoTo ErrH
 
strTbl = "Table1"
DoCmd.OpenTable strTbl, acViewNormal
' Au cas où
DoCmd.SelectObject acTable, strTbl
Set fm = Screen.ActiveDatasheet
 
For Each ctl In fm.Controls
    ctl.ColumnWidth = -2
Next
 
ExitSub:
Exit Sub
 
ErrH:
Select Case Err.Number
End Select
MsgBox "Erreur " & Err.Number & " : " & Err.Description, , "cmdLargeurAutoTable1_Click()"
Resume ExitSub
End Sub

C'est l'affectation de la valeur -2 à Columnwidth qui fait tout.

A+

[azertix]

Wow, le paramètre -2 n'est même pas évoqué dans l'aide de VBA
Merci pour ta réponse.

Je vais maintenant préciser ma demande.
Je voudrais intégrer cet ajustement automatique à un code à moi dans lequel je crée des tables à la volée via DAO depuis un fichier texte.
Je me suis fortement inspiré de ceci :
http://warin.developpez.com/access/d...tie_4#L4.3.4.4

Peut-on définir l'ajustement auto au moment de la création de la table ou faut-il intervenir après sa création ?

[LedZeppII]

Bonsoir,

Envoyé par azertix

Peut-on définir l'ajustement auto au moment de la création de la table ou faut-il intervenir après sa création ?

Je ne sais pas.
J'imagine que pour chaque colonne il faut parcourir les enregistrements pour déterminer la chaîne de caractères la plus longue.
La fonction cachée TwipsFromFont peut-être utile.

Ensuite on peut définir la propriété ColumnWidth des champs d'un objet TableDef
Dans cet exemple je définis la largeur (en twips) de deux colonnes.

Code :

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
Sub LargColonneTableDef()
Dim db As DAO.Database
Dim tdef As DAO.TableDef
 
Set db = CurrentDb
Set tdef = db.TableDefs("tblTestLargCol")
 
SetFieldProperty tdef.Fields("Champ1"), "ColumnWidth", 2000
SetFieldProperty tdef.Fields("Champ2"), "ColumnWidth", 4000
 
End Sub
 
Sub SetFieldProperty(oFld As DAO.Field, sProp As String, vVal As Variant)
Dim oProp As DAO.Property
 
On Error GoTo ErrH
Set oProp = oFld.Properties(sProp)
' Si la propriété n'exite pas on la crée et on l'ajoute
' à la collection
If oProp Is Nothing Then
   Select Case sProp
       ' Type Integer
       Case "ColumnWidth", "ColumnOrder"
          Set oProp = oFld.CreateProperty(sProp, dbInteger, -1)
          oFld.Properties.Append oProp
       ' Type Boolean
       Case "ColumnHidden"
          Set oProp = oFld.CreateProperty(sProp, dbBoolean, False)
          oFld.Properties.Append oProp
   End Select
End If
 
oProp.Value = vVal
 
SubExit:
Exit Sub
 
ErrH:
Select Case Err.Number
    Case 3270 ' Propriété non trouvée.
         Resume Next
End Select
MsgBox Err.Number & " : " & Err.Description, , "Erreur"
Resume SubExit
End Sub

A+

[azertix]

LedZeppII, une solution personnalisée à votre problème !

Merci