Erreur d'execution '13' entre deux macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour tous le monde

Voila je suis face à une erreur dont j'arrive pas à trouver la cause, en effet j'ai deux userform qui contiennent des macros le premier contient un combobox qui m'affiche la liste des fournisseur et un bouton qui appel le deuxième userform et dans ce deuxième userfom de textbox qui permet d'ajouter un nouveau fournisseur qui envoi les données vers une feuille nommée "Liste_fournisseur"

jusque là tout fonctionne bien mais dès que je vide la feuille "Liste_fournisseur" en la remettant à zéro au lancement de l'userform il y a débogage Erreur d'execution '13'

Voici l'ensemble des macros de l'userform menu

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim f, choix1()
 
Private Sub CommandButton1_Click()
AjoutFournisseurs.Show
End Sub
 
Private Sub UserForm_Initialize()
 Set f = Sheets("liste_Fournisseurs")
  choix1 = Application.Transpose(f.Range("d12:D" & f.[D65000].End(xlUp).Row))
  Me.ComboBox1.List = choix1
End Sub
Private Sub ComboBox1_Change()
 If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, choix1, 0)) Then
   Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
  End If
End Sub

Et celles-ci de l'userform ajoutfournisseur

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
46
47
Private Sub AjoutNouveauFournisseur_Click()
 
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
 
  'Si le Fourniseurs_TextBox est vide ou c'est une valeur numérique
  If Trim(Fourniseurs_TextBox) = "" Or IsNumeric(Fourniseurs_TextBox) Then
  'Alors arrêt avec ce message en sortant de la boucle et en retourant sur Fourniseurs_TextBox
  MsgBox "Votre cellule est vide ou en format incorrecte! Veuillez le redéfinir", vbCritical
  On Error GoTo 0: Fourniseurs_TextBox.SetFocus: Exit Sub
  End If
  With Worksheets("Liste_Fournisseurs")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
        For Each Ctrl In AjoutFournisseurs.Controls
        r = Val(Ctrl.Tag)
                If r > 0 Then .Cells(Derligne, r) = Ctrl
        Next
      Fourniseurs_TextBox = ""
      Fourniseurs_TextBox.SetFocus
   End With
    ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Add Key:= _
        Range("D12:D" & Derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Add Key:= _
        Range("C12:C" & Derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort
        .SetRange Range("B11:D" & Derligne)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   End Sub
 
Private Sub Annulation_Click()
Unload AjoutFournisseurs
End Sub
 
Private Sub UserForm_Initialize()
  DateBox.Value = FormatDateTime(Now, vbShortDate)
End Sub

et ici le fichier joins pour être plus claire

Merci à vous tous cordialement

08/05/2015, 01h18
joe.levrai

Bonjour,

Code:

choix1 = Application.Transpose(f.Range("d12:D" & f.[D65000].End(xlUp).Row))

ton en-tête est en D11

donc quand ta liste est vide : choix = le titre de la colonne et une ligne vide <>D12:D11
et ensuite, quand tu écris le premier fournisseur, que se passe-t-il ? Transpose nécessite combien de cellules au minimum ?

deux solutions :

- revoir le positionnement
- revoir la ligne de code

bon tests
08/05/2015, 16h47
INFINITY100

Bonjour

Merci pour la réponse

Et bien à l'essai il faut deux lignes minimum pour que ça bug pas

Donc je pense il faut revoir ce code afin de qu'il accepte la liste des fournisseurs vierge dans un premier temps et qu'il bug pas lors d'ajout du premier fournisseur et c'est là ou je me coince.

Une idée l'ami ?
09/05/2015, 08h11
joe.levrai

Bonjour,

il suffit de connaître la ligne résultant du calcul

Code:

f.[D65000].End(xlUp).Row

si = 11 : la liste est vide ==> ne rien faire
si = 12 : il n'y a qu'un élément ==> le mettre dans choix 1
si > 12 : on crée la liste avec un transpose qui met la plage dans choix1

Code:

choix1 = Application.Transpose(f.Range("d12:D" & f.[D65000].End(xlUp).Row))

très simple

Bonjour Joe levrai

Et bien merci pour le fil après essai cette macro fait bien l'affaire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Sub UserForm_Initialize()
 
  Dim f As Worksheet, Choix1, Nbl&
 
  Set f = Sheets("liste_fournisseurs")
  Nbl = f.[D1048576].End(xlUp).Row
  Select Case Nbl
    Case Is < 12
    Exit Sub
    Case 12
    Me.ComboBox1.AddItem f.Range("D12")
    Case Else
    Choix1 = Application.Transpose(f.Range("D12:D" & Nbl))
    Me.ComboBox1.List = Choix1
  End Select
End Sub

Merci encore mon ami ;)