Erreur avec Ubound

Le 09/05/2020 à 19:19

Bonjour,

J'essaie de construire un tableur pour la gestion de mes agents.

Je souhaite qu'une feuille nommée Data soit renseignée par un userform.

Et pour saisir les adresses je souhaite que l'on puisse choisir un code postal qui amène à une ville.

J'ai donc fouillé les forum et j'ai trouvé ce code que je modifie pour mon usage et j'ai un problème avec une erreur "Tableau attendu" alors que j'ai bien une plage nommée BDD.

Pourriez-vous m'aider ?

Merci

645852020102.xlsm (887.39 Ko)
Option Explicit
' Déclaration des variables et constantes de portées module
Enum Status ' Constantes énumérées Status
 Consultation = 0: Modify = 1: NewRec = 2: Remove = 3
End Enum
Const StatusLabel As String = "Consultation;Modification;Création;Suppression"
Const appTitle As String = "Musar Fra C - gestion des agents"
Dim UserFormStatus As Byte ' Statut du type de travail (Consultation, Modify, NewRec, Remove)
Dim CurrentRecord As Long  ' Enregistrement en cours
Dim rng As Range           ' Plage de données traitée par le formulaire
Dim lstStatusText() As String
Dim f, ligneEnreg, ListeVille()
Dim b As Integer

Private Sub UserForm_Initialize()

  '--villes +codes postaux
  ListeVille = Range("BDD").Value
  Me.ComboVille.List = ListeVille
  b = Application.index(["BDD"], Evaluate("Row(1:" & ["BDD"].Rows.Count & ")"), Array(1, 2))
  Tri b, 1, 1, UBound(b)
  Me.CodePostal.List = b
  '-- activités

End Sub

Private Sub ComboVille_Change()
 On Error Resume Next
 If ActiveControl.Name <> "ComboVille" Then Exit Sub
 On Error GoTo 0
 If Me.ComboVille.ListIndex = -1 And _
     IsError(Application.Match(Me.ComboVille, Application.index(ListeVille, , 1), 0)) Then
     Dim b()
     Me.CodePostal = ""
     clé = UCase(Me.ComboVille) & "*"
     n = 0
     For i = LBound(ListeVille) To UBound(ListeVille)
       If UCase(ListeVille(i, 1)) Like clé Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = ListeVille(i, 1): b(2, n) = ListeVille(i, 2)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n + 1)
        Me.ComboVille.List = Application.Transpose(b)
        Me.ComboVille.RemoveItem n
      End If
      Me.ComboVille.DropDown
   Else
      On Error Resume Next
      Me.CodePostal = Me.ComboVille.Column(1)
   End If
End Sub

Private Sub CodePostal_Change()
 On Error Resume Next
 If ActiveControl.Name <> "CodePostal" Then Exit Sub
 On Error GoTo 0
 If Me.CodePostal.ListIndex = -1 And _
     IsError(Application.Match(Me.CodePostal, Application.index(ListeVille, , 2), 0)) Then
     Dim b()
     clé = UCase(Me.CodePostal) & "*"
     n = 0
     For i = LBound(ListeVille) To UBound(ListeVille)
       If UCase(ListeVille(i, 2)) Like clé Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = ListeVille(i, 2): b(2, n) = ListeVille(i, 1)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n + 1)
        Me.CodePostal.List = Application.Transpose(b)
        Me.CodePostal.RemoveItem n
      End If
      Me.CodePostal.DropDown
   Else
      On Error Resume Next
      Me.ComboVille = Me.CodePostal.Column(1)
   End If
End Sub
Sub Tri(a, ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: D = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(D, ColTri): D = D - 1: Loop
    If g <= D Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(D, k): a(D, k) = temp
       Next k
       g = g + 1: D = D - 1
    End If
  Loop While g <= D
  If g < droi Then Call Tri(a, ColTri, g, droi)
  If gauc < D Then Call Tri(a, ColTri, gauc, D)
End Sub

Private Sub UserForm_Activate()
 InitVariable ' Initialisation des variables
 InitData     ' Initialisation adresse liste des données + RowSource
 InitComboBox ' Initialisation ComboBox
 UserFormStatus = Status.Consultation ' Consultation par défaut
 With Me      ' Initialisation de certains contrôles
 .cmdConfirm.Visible = False: .cmdCancel.Visible = False
 .cboMember.Enabled = True: .frmMember.Enabled = False
 usfTitle     ' Titre du UserForm (Propriété Caption)
 End With
 ' Focus sur le 1er enregistrement ou l'enregistrement sélectionné dans la feuille
 With Me: .cboMember.ListIndex = Me.Tag: End With
 Call LtvPers_Alimentation

End Sub
Private Sub InitVariable()
 lstStatusText = Split(StatusLabel, ";")
 With Me
 .optMale.GroupName = "Gender": Me.optFemale.GroupName = "Gender"
  If Len(.Tag) = 0 Then .Tag = 0
 End With
End Sub
Private Sub InitComboBox()
 With Me.cboMember
 .ColumnHeads = True: .ColumnCount = 10: .ColumnWidths = "0;0;0;90;90;0;0;0;15;0"
 End With
 InitRowSource '
End Sub
Private Sub InitData()
 ' Redimensionnement de l'objet rng et RowSource
 Set rng = Datas.Range("A4").CurrentRegion
 With rng
  Set rng = .Offset(1).Resize(.Rows.Count - 1)
 End With
End Sub
Private Sub InitRowSource()
 With Me.cboMember
 .RowSource = rng.Address(external:=True)
 .ListIndex = 0 ' Force la sélection du premier enregistrement
 End With
End Sub
Private Sub cboMember_Click()
 CurrentRecord = Me.cboMember.ListIndex
 ReadRecord CurrentRecord ' Lecture de l'enregistrement sélectionné
 CheckButton
End Sub
Private Sub cmdCancel_Click()
 ReadRecord CurrentRecord
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdConfirm_Click()
 Select Case UserFormStatus
   Case Status.NewRec ' Nouvel enregistrement
     WriteRecord rng.Rows.Count: InitData: InitRowSource
     Me.cboMember.ListIndex = rng.Rows.Count - 1
   Case Status.Modify: WriteRecord CurrentRecord ' Modification de l'enregistrement
 End Select
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdExit_Click()
 Unload Me ' Fermeture du UserForm
End Sub
Private Sub cmdModify_Click()
 UserFormStatus = Status.Modify
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdNew_Click()
 UserFormStatus = Status.NewRec
 ClearTextBox   ' Efface les valeurs des TextBox
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub ClearTextBox()
 ' Efface toutes les valeurs contenues dans les contrôles TextBox du frame nommé frmMember
 Dim Ctrl As Control
 For Each Ctrl In Me.frmMember.Controls
  If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
 Next
End Sub
Private Sub RemoveRecord(ByVal RecordNumber As Long)
 ' Suppression de l'enregistrement
 ' Contrainte : il doit rester un enregistrement
 Select Case True
  Case rng.Rows.Count = 1 ' Reste 1 enregistrement
    MsgBox "Vous devez laisser un enregistrement", vbInformation, "Suppression impossible"
  Case MsgBox("Voulez-vous supprimer la ligne sélectionnée", _
            vbCritical + vbYesNo + vbDefaultButton2, _
            "Suppression de la ligne " & CurrentRecord + 1) = vbYes
     RecordNumber = RecordNumber + 1
     rng.Rows(RecordNumber).Delete Shift:=xlUp ' Supprime la ligne de la plage
     InitData      ' Initialisation des variables objets
     InitRowSource ' Initialisation de la propriété RowSource
     CurrentRecord = 0: Me.cboMember.ListIndex = CurrentRecord
 End Select
 UserFormStatus = Status.Consultation
End Sub
Private Sub cmdNext_Click()
 Me.cboMember.ListIndex = CurrentRecord + 1
End Sub
Private Sub cmdPrevious_Click()
 Me.cboMember.ListIndex = CurrentRecord - 1
End Sub
Private Sub cmdFirst_Click()
 Me.cboMember.ListIndex = 0
End Sub
Private Sub cmdLast_Click()
 Me.cboMember.ListIndex = rng.Rows.Count - 1
End Sub
Private Sub cmdRemove_Click()
 UserFormStatus = Status.Remove: usfTitle
 RemoveRecord CurrentRecord ' Supprime l'enregistrement courant
 UserFormStatus = Status.Consultation: usfTitle
End Sub
Private Sub ReadRecord(ByVal RecordNumber As Long)
 ' Lecture de l'enregistrement
 RecordNumber = RecordNumber + 1
 With rng
  Me.txtMatricule = .Cells(RecordNumber, 9)
  Me.txtName = .Cells(RecordNumber, 4)
  Me.txtFonction = .Cells(RecordNumber, 5)
  Me.txtDateDeb = .Cells(RecordNumber, 6)
  Me.txtDateFin = .Cells(RecordNumber, 7)
  Me.txtVisite = .Cells(RecordNumber, 8)
  If UCase(.Cells(RecordNumber, 10)) = "F" Then Me.optFemale.Value = True Else Me.optMale = True
  Me.frmMember.Caption = "Fiche " & Format(RecordNumber, "R000")
 End With
End Sub
Private Sub WriteRecord(ByVal RecordNumber As Long)
 ' Ecriture de l'enregistrement
 Me.cboMember.ListIndex = -1
 RecordNumber = RecordNumber + 1
 With rng
  With .Cells(RecordNumber, 2)
   If Len(.Value) = 0 Then ' ID
    .Value = Application.WorksheetFunction.Max(rng.Columns(2)) + 1
   End If
  .NumberFormat = "\R000" ' Format
  End With
 .Cells(RecordNumber, 2) = Me.txtMatricule
 .Cells(RecordNumber, 3) = Me.txtName
 .Cells(RecordNumber, 5) = Me.txtFonction
 .Cells(RecordNumber, 6) = Me.txtDateDeb
 .Cells(RecordNumber, 7) = Me.txtDateFin
 .Cells(RecordNumber, 8) = Me.txtVisite
 .Cells(RecordNumber, 10) = IIf(Me.optFemale = True, "F", "M")
 End With
 Me.cboMember.ListIndex = CurrentRecord
End Sub
Sub OppositeStatus()
 ' Inverse la valeur booléenne des boutons d'action
 ' Modifie la propriété Caption du UserForm
 With Me
 .cboMember.Enabled = Not .cboMember.Enabled
 .frmMember.Enabled = Not .frmMember.Enabled
 .frmAction.Visible = Not .frmAction.Visible
 .cmdCancel.Visible = Not .cmdCancel.Visible
 .cmdConfirm.Visible = Not .cmdConfirm.Visible
 .cmdExit.Visible = Not .cmdExit.Visible
 .frmNavigation.Visible = Not .frmNavigation.Visible
  If .cboMember.Enabled = True Then UserFormStatus = Status.Consultation ' Consultation
  usfTitle ' Titre du UserForm
 End With
End Sub
Private Function usfTitle()
 ' Modifie la propriété Caption du UserForm
 Me.Caption = appTitle & " - " & lstStatusText(UserFormStatus)
End Function
Sub CheckButton()
 With Me
 .cmdFirst.Enabled = CurrentRecord > 0
 .cmdPrevious.Enabled = CurrentRecord > 0
 .cmdNext.Enabled = CurrentRecord <> rng.Rows.Count - 1
 .cmdLast.Enabled = CurrentRecord <> rng.Rows.Count - 1
 End With
End Sub
Private Sub UserForm_Terminate()
 Set rng = Nothing
 MsgBox "Bonne mission"
End Sub

Sub LtvPers_Alimentation()
Dim f As Worksheet
Dim Lr As Long
Dim Ligne As Integer
Dim q As Variant
Set f = ThisWorkbook.Sheets(DATASOURCEFEUIL)

    With Me.LtvPers
        .ListItems.Clear

            With .ColumnHeaders
                .Clear
                .Add , , "Id.", 25, lvwColumnLeft
                .Add , , "Matricule", 45, lvwColumnLeft
                .Add , , "Nom", 120, lvwColumnLeft
                .Add , , "Prénom", 100, lvwColumnLeft
                .Add , , "Date de naissance", 45, lvwColumnCenter
                .Add , , "Ville de naissance", 120, lvwColumnLeft
                .Add , , "Dpt Naissance", 80, lvwColumnLeft
                .Add , , "Adresse", 120, lvwColumnLeft
                .Add , , "Code postal", 55, lvwColumnLeft
                .Add , , "Ville", 120, lvwColumnLeft
                .Add , , "Fonction", 100, lvwColumnLeft
                .Add , , "Date début de mission", 1, lvwColumnCenter
                .Add , , "Date fin de mission", 1, lvwColumnCenter
                .Add , , "Visite médicale", 68, lvwColumnCenter
                .Add , , "Matricule", 45
                .Add , , "Sexe", 30
            End With

        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True

        Lr = f.Range("A" & Rows.Count).End(xlUp).Row
        If Lr = 2 Then Exit Sub

            Ligne = 1
        For Each q In f.Range("A3:A" & Lr)
            .ListItems.Add , , q
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 1)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 2)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 3)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 4)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 5)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 6)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 7)
            .ListItems(Ligne).ListSubItems.Add , , q.Offset(, 8)

            Ligne = Ligne + 1
        Next q

        lblNbReg.Caption = LtvPers.ListItems.Count
    End With
    LtvPers.Refresh
Set f = Nothing
End Sub
Le 09/05/2020 à 21:53

Bonsoir,

à tout hasard, retirez les parenthèse dans la définition de variable "ListeVille".

Le fait d'affecter une plage de feuille à une variable, VBA la considère automatiquement comme un tableau, je crois.

@ bientôt

LouReeD

Le 10/05/2020 à 06:23

Bonjour le fil

Alors

Dim b As Integer

Et

Tri b, 1, 1, UBound(b)

Sont forcément incompatibles

Ubound est pour un tableau

Si tu veux que le code fonctionne, il faut que tu désactives "Option Explicit" ce que je déconseille

Mieux vaut définir les variables

Dim b() As Variant

Comme ta plage est définie, il suffit d'utiliser

b = Range("BDD").Value

@+

Le 10/05/2020 à 10:30

Bonjour,

Il est parfois difficile de suivre les évolutions administratives...

Le code postal aujourd'hui à bien évolué :

Entre bureau distributeur, villes, villages et regroupement de communes les mairies elles-même semblent ne plus trop savoir ou elles habitent...

Selon le code postal que tu utilises qui est de la dernière génération (avec regroupent de communes) de nombreuses communes ont maintenant un code postal identique.

Dans certains cas (ou les communes sont absorbées depuis très longtemps ?) 1 ligne semble-t-il est suffisante

Code Postal + Ville ou Ville d'intégration( ou intercommunalités...)

69700 GIVORS

52330 COLOMBEY LES DEUX EGLISES

Dans beaucoup de cas 2 lignes sont nécessaires. Certains regroupement peuvent héberger jusqu'à 20 communes... et il y a fort à parier que la liste n'est pas limitatives !

1- Ville

2- Code Postal + commune d'intégration

Exemples :

HARRICOURT

52330 COLOMBEY LES DEUX EGLISES

BELLEGARDE SUR VALSERINE

01200 VALSERHONE

Enfin les départements d'outremer obéissent à une autre logique :

Ex GAMBIER ou MOOREA (et beaucoup d'autres...) : il semble difficile un peu inutile de les intégrer dans cette logique...

Dans ces conditions il me semble impossible de saisir correctement des adresses postales avec 2 combos, personnellement si je devais m'y atteler je tenterai plutôt 1 TextBox + 2 Combo ou 2 TextBox +1 Combo... (mais je ne suis pas candidat !)

A+

Le 11/05/2020 à 19:29

Bonsoir,

Du coup j'ai repris cela à zéro et prenant un exemple de Boisgontier Jacques que j'ai adapté mais là encore je ne comprend pas excel me demande de définir les variable bd, a , b dans le code suivant :

Private Sub UserForm_Initialize()
  Set f = Sheets("BDdata")
  Set bd = Range("a2:d" & [A65000].End(xlUp).Row)
  a = Application.index(bd, , 1)
  Tri a, 1, 1, UBound(a)
  '--villes +codes postaux
  ListeVille = Range("T_Ville").Value
  Me.ComboVille.List = ListeVille
  b = Application.index([T_Ville], Evaluate("Row(1:" & [T_Ville].Rows.Count & ")"), Array(2, 1))
  Tri b, 1, 1, UBound(b)
  Me.CodePostal.List = b

End Sub

or sur le fichier exemple ces variables ne sont déclarées nul part o_O

Je vous joint mon nouveau classeur, pourriez vous me dire ce que j'ai mal fait ?

185852020102-version-1.xlsb (170.22 Ko)

Merci

Le 11/05/2020 à 19:55

Bonjour,

avec mes peu de notion, je dirai de déclarer tes variables f, db, a,b

Dim bd As Range
Dim f As Worksheets
Dim a As Variant 'moins sure
Dim b As Application 'moins sure

Ensuite relmplace

Set bd = Range("a2:d" & [A65000].End(xlUp).Row)

par

Set bd = Range("a2:d" & Range("A65000").End(xlUp).Row)

Je laisse ensuite plus fort que moi

Le 11/05/2020 à 20:14

Eh bien je viens d'essayer votre proposition et maintenant j'ai une erreur à cette ligne

b = Application.index([T_Ville], Evaluate("Row(1:" & [T_Ville].Rows.Count & ")"), Array(2, 1))

avec le message "Utilisation incorrect de la propriété"

Le 11/05/2020 à 21:31

Bonsoir,

pour reprendre le code de Boisgontier Jacques il ne faut pas avoir inscrit en haut de votre page de code

Option Explit

Certains vous dirons alors que ce n'est pas bien, alors en cas d'incertitude, laissez VBA gérer le type de variable tout seul en ne mettant "que" :

VBA adaptera alors tout seul le type de variable.

@ bientôt

LouReeD

Le 11/05/2020 à 22:15

Bonsoir le fil, LooReeD

Effectivement ce n'est pas bien

Ça évite les erreurs d'orthographe des variables, comme ListTravail pour ListeTravail

Mais avec des a, b, c, etc... Ça devrait aller

Sinon voici ce que je ferais pour résoudre le problème des communes/Codes PTT

Fitrage de la liste des communes en fonction de la saisie

@+

40fa1con74-5852020102.xlsm (78.32 Ko)
Le 12/05/2020 à 10:31

Merci beaucoup, votre solution fonctionne sur votre PC je suppose car chez moi j'ai une erreur "Projet ou bibliothèque introuvable pour Ucase à cette ligne 

Private Sub ReadRecord(ByVal RecordNumber As Long)
  ' Lecture de l'enregistrement
  RecordNumber = RecordNumber + 1
  With rng
    Me.txtMatricule = .Cells(RecordNumber, 2)
    Me.txtName = .Cells(RecordNumber, 3)
    Me.txtLastName = .Cells(RecordNumber, 4)
    Me.txtBirthday = .Cells(RecordNumber, 5)
    Me.CbxVilleBirth = .Cells(RecordNumber, 6)
    Me.txtAdresse = .Cells(RecordNumber, 8)
    Me.txtCodPost = .Cells(RecordNumber, 9)
    Me.txtCommune = .Cells(RecordNumber, 10)
    Me.txtPhoneDom = .Cells(RecordNumber, 11)
    Me.txtPhonePor = .Cells(RecordNumber, 12)
    Me.txtNumSecu = .Cells(RecordNumber, 13)
    Me.txtFonction = .Cells(RecordNumber, 14)
    Me.txtDateDeb = .Cells(RecordNumber, 15)
    Me.txtDateFin = .Cells(RecordNumber, 16)
    Me.txtVisite = .Cells(RecordNumber, 17)
    Me.txtMail = .Cells(RecordNumber, 18)
    If [Surligner]UCase[/Surligner](.Cells(RecordNumber, 19)) = "F" Then Me.optFemale.Value = True Else Me.optMale = True
    Me.frmMember.Caption = "Fiche " & Format(RecordNumber, "R000")
  End With
End Sub

Alors je ne comprend pas

Le 12/05/2020 à 10:41

Re,

Effectivement, j'ai oublié de spécifier

Tu utilises une bibliothèque pour un ListView qui n'était pas présent sur mon PC

L'erreur est aléatoire dans ce cas là

Ce qu'il faut faire,

Aller dans le menu -> Outils -> Référence de VBAProject

Logiquement il devrait y avoir une ligne

[MANQUANT]Microsoft Windows Common Contol 6.0 (SP6)

Il faut la décocher et valider par OK

Une nouvelle fenêtre va alors apparaître en indiquant qu'un contrôle utilise une bibliothèque... bla bla

Il faut cliquer sur OK

Et normalement dans le menu de tout à l'heure tu dois bien avoir de coché sans mention

Microsoft Windows Common Contol 6.0 (SP6)

Suite à cela, le code devrait fonctionner sans souci

@+

Le 12/05/2020 à 11:49

Merci beaucoup, problème résolu

Rechercher des sujets similaires à "erreur ubound"