XL 2016 erreur d'exécution

[marc.gilliand]

Bonjour,
J'ai plusieurs userforms dans mon programme de suivi des débiteurs. Dans l'USF 5, je n'arrive pas à le charger.
Voici mon code :
Dim pièceactuelle As String

Private Sub CommandButton2_Click()

Dim Debid As String

Dim typepce As String
Dim datepmt As Date
Dim PDPID As String
Dim montant As Variant

Debid = Sheets("USF5").Cells(4, 2).Value
typepce = "Plan de paiement"
datepmt = Sheets("USF5").Cells(13, 2).Value
PDPID = Sheets("USF5").Cells(16, 2).Value
montant = Sheets("USF5").Cells(11, 2).Value

Sheets("Règlements").Cells(4, 2).Value = Debid
Sheets("Règlements").Cells(4, 4).Value = typepce
Sheets("Règlements").Cells(4, 6).Value = typepce
Sheets("Règlements").Cells(6, 4).Value = datepmt
Sheets("Règlements").Cells(6, 6).Value = datepmt
Sheets("Règlements").Cells(9, 4).Value = PDPID
Sheets("Règlements").Cells(9, 6).Value = PDPID
Sheets("Règlements").Cells(12, 6).Value = montant

mettreajourcredit

'rafraichir le tableau:

RefreshLstPmt

'rafraichissement listbox
Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)



ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"

'retour acueil
Unload Me
UserForm1.Show

End Sub

Private Sub CommandButton3_Click()

With Application
.WindowState = xlMaximized


Zoom = Int(.Width / Me.Width * 100)
Width = .Width
Height = .Height
End With

With UserForm1
.Top = Application.Top
.Left = Application.Left
End With

End Sub

Private Sub Frame1_Click()

End Sub

Private Sub Frame3_Click()

End Sub

Private Sub OptionButton13_Click()
Unload Me
UserForm2.Show
End Sub

Private Sub OptionButton14_Click()
Unload Me
UserForm3.Show
End Sub

Private Sub OptionButton15_Click()
Unload Me
UserForm4.Show
End Sub

Private Sub OptionButton16_Click()
Unload Me
UserForm5.Show
End Sub

Private Sub OptionButton17_Click()
Unload Me
UserForm6.Show
End Sub

Private Sub OptionButton18_Click()
Unload Me
UserForm11.Show
End Sub

Private Sub OptionButton19_Click()
Unload Me
UserForm14.Show
End Sub

Private Sub OptionButton20_Click()
Unload Me
UserForm13.Show
End Sub

Private Sub OptionButton21_Click()

'Lien sur poursuite
Debid = Sheets("USF2").Range("B3").Value
Sheets("R1").Range("O12").Value = Debid
Unload Me
Sheets("R1").Unprotect ("bfbg")
Sheets("R1").Activate
End Sub

Private Sub OptionButton22_Click()

'Lien sur poursuite
Debid = Sheets("USF2").Range("B3").Value
Sheets("R2").Range("O12").Value = Debid
Unload Me
Sheets("R2").Unprotect ("bfbg")
Sheets("R2").Activate
End Sub

Private Sub OptionButton23_Click()

'Lien sur poursuite
Debid = Sheets("USF2").Range("B3").Value
Sheets("R3").Range("O12").Value = Debid
Unload Me
Sheets("R3").Unprotect ("bfbg")
Sheets("R3").Activate
End Sub

Private Sub OptionButton24_Click()

'Lien sur poursuite
Debid = Sheets("USF2").Range("B3").Value
Sheets("RPDP").Range("O12").Value = Debid
Unload Me
Sheets("RPDP").Unprotect ("bfbg")
Sheets("RPDP").Activate
End Sub

Private Sub OptionButton25_Click()
Unload Me
UserForm7.Show
End Sub

Private Sub OptionButton26_Click()
Unload Me
UserForm8.Show
End Sub

Private Sub OptionButton27_Click()
Unload Me
UserForm9.Show
End Sub

Private Sub OptionButton28_Click()
Unload Me
UserForm10.Show
End Sub

Private Sub OptionButton29_Click()
Unload Me
UserForm12.Show
End Sub

Private Sub OptionButton30_Click()
Unload Me
UserForm15.Show
End Sub


Private Sub TextBox19_Change()

Sheets("USF5").Cells(13, 2).Value = TextBox19.Value

End Sub

Private Sub TextBox21_Change()

Sheets("USF5").Cells(14, 2).Value = TextBox21.Value

End Sub

Private Sub TextBox23_Change()

Sheets("USF5").Cells(11, 2).Value = TextBox23.Value

End Sub

Private Sub TextBox41_Change()

If TextBox41.Value = vbNullString Then
ListBox1.List = Sheets("ListePaiements").Range("A1:K10000").Value

Else

FindText Sheets("ListePaiements").Range("A1:G10000"), TextBox41.Value, ListBox1

End If
End Sub

Private Sub UserForm_Initialize()
'taille USF
UserForm5.Height = 505
UserForm5.Width = 960

'Rafraicchissement données LB
RefreshLstPmt

'initialisation formulaire
Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)



ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"

'initialisation pièce
Sheets("USF5").Cells(16, 2).Value = Sheets("USF0").Cells(1, 1).Value

'récupération données lignes
TextRow = ListBox1.ListIndex
strCol1 = ListBox1.List(TextRow, 3)
Sheets("USF5").Cells(16, 2).Value = strCol1

'Alimentation données utilisateur
TextBox40.Value = Sheets("USF5").Cells(3, 2).Value
TextBox14.Value = Sheets("USF5").Cells(4, 2).Value
TextBox20.Value = Sheets("USF5").Cells(5, 2).Value
TextBox22.Value = Sheets("USF5").Cells(6, 2).Value
TextBox24.Value = Sheets("USF5").Cells(7, 2).Value
TextBox26.Value = Sheets("USF5").Cells(8, 2).Value

'alimentation données pièce
TextBox17.Value = "Plan de paiement"
TextBox2.Value = Sheets("USF5").Cells(4, 2).Value
TextBox12.Value = Sheets("USF5").Cells(18, 2).Value
TextBox10.Value = Sheets("USF5").Cells(19, 2).Value
TextBox9.Value = Sheets("USF5").Cells(20, 2).Value
TextBox28.Value = Sheets("USF5").Cells(21, 2).Value
TextBox11.Value = Sheets("USF5").Cells(22, 2).Value
TextBox23.Value = Sheets("USF5").Cells(24, 2).Value
TextBox37.Value = Sheets("USF5").Cells(26, 2).Value

End Sub

Private Sub ListBox1_Change()
On Error Resume Next
Dim strCol1 As String
Dim TextRow As Long

'récupération données lignes
TextRow = ListBox1.ListIndex
strCol1 = ListBox1.List(TextRow, 3)
Sheets("USF5").Cells(16, 2).Value = strCol1

'Alimentation données utilisateur
TextBox40.Value = Sheets("USF5").Cells(3, 2).Value
TextBox14.Value = Sheets("USF5").Cells(4, 2).Value
TextBox20.Value = Sheets("USF5").Cells(5, 2).Value
TextBox22.Value = Sheets("USF5").Cells(6, 2).Value
TextBox24.Value = Sheets("USF5").Cells(7, 2).Value
TextBox26.Value = Sheets("USF5").Cells(8, 2).Value

'alimentation données pièce
TextBox17.Value = "Plan de paiement"
TextBox2.Value = Sheets("USF5").Cells(4, 2).Value
TextBox12.Value = Sheets("USF5").Cells(18, 2).Value
TextBox10.Value = Sheets("USF5").Cells(19, 2).Value
TextBox9.Value = Sheets("USF5").Cells(20, 2).Value
TextBox28.Value = Sheets("USF5").Cells(21, 2).Value
TextBox11.Value = Sheets("USF5").Cells(22, 2).Value
TextBox23.Value = Sheets("USF5").Cells(24, 2).Value
TextBox37.Value = Sheets("USF5").Cells(26, 2).Value

pièceactuelle = strCol1
Sheets("USF0").Cells(1, 1).Value = strCol1


End Sub

Public Sub FindText(SourceRng As Range, Text As String, List As MSForms.ListBox)

Dim RngToArr As Variant 'Variable for taking range to an array.
RngToArr = SourceRng.Value 'Convert range to array.

Dim i As Long 'For outer loop..Loop from 0 to (total row-1).
Dim j As Long 'For inner loop..Loop from 1 to total column.
Dim k As Long 'For taking data to list.
Dim L As Long 'For indexing in Listbox.
Dim IsIn As Boolean 'For exit option or Checking is the data in the row or not.

With List
.Clear
For i = 0 To UBound(RngToArr, 1) - 1 'UBound(RngToArr, 1) count how many row are there. let say m = UBound(RngToArr, 1)
'So the order will be m*n (row*col)
IsIn = False 'Initial value is false.
For j = 1 To UBound(RngToArr, 2) 'Run the inner loop.
If InStr(1, UCase(RngToArr(i + 1, j)), UCase(Text)) <> 0 Then 'Check if the search text is there or not.
IsIn = True 'If the data is present then set IsIn to true.
Exit For 'And no need to run the inner loop anymore.
End If
Next j

If IsIn = True Then
.ColumnCount = UBound(RngToArr, 2) 'Define the Column count to total column.
.AddItem 'Start adding item.
For k = 0 To UBound(RngToArr, 2) - 1
.List(L, k) = RngToArr(i + 1, k + 1) 'Run this for putting the value to the list.
Next k
L = L + 1 'Increase the index for listbox.
End If
Next i

End With

End Sub

Private Sub Trier1_Click()

Sortcolumn1

ListBox1.ColumnCount = 8

Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)




ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"


End Sub

Private Sub Trier2_Click()

Sortcolumn2

ListBox1.ColumnCount = 8

Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)




ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"


End Sub

Private Sub Trier3_Click()

Sortcolumn3

ListBox1.ColumnCount = 8

Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)




ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"


End Sub

Private Sub Trier4_Click()

Sortcolumn4

ListBox1.ColumnCount = 8

Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)




ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"


End Sub

Private Sub Trier8_Click()

Sortcolumn8

ListBox1.ColumnCount = 8

Set bddfeuil1 = Sheet14.[A1].CurrentRegion

Me.ListBox1.ColumnCount = 8
Me.ListBox1.ColumnHeads = True

Set fplage = Sheet14.[A1].CurrentRegion.Offset(1)

Me.ListBox1.RowSource = fplage.Address(external:=True)




ListBox1.ColumnWidths = "40;80;25;65;70;70;70;5"


End Sub

Et voici l'erreur remonté par Excel :

Merci de votre aide.

 

[Bernard_XLD]

Salut Patrick

l'erreur vient de cette ligne dans l'initialisation de l'Usf 5, normal avec TextRow à -1

strCol1 = ListBox1.List(TextRow, 3)

 

[patricktoulon]

@Yeahou
je ne sais pas je ne suis pas allé plus loin sachant que des le départ il est out of order avec son rowsource
mais oui il y a certainement d'autres erreurs je n'en doute pas

 

[job75]

c'est lorsque que je clique sur un élément de la ListeBox1 de n'importe quel USF que cette cellule prend la valeur et la garde pour que je puisse naviguer dans mes différents USF.

Vous voulez savoir pourquoi il y a bug donc je vous l'ai dit, après c'est à vous de voir.

Ou plutôt à ceux qui vous ont concocté cette usine à gaz.

J'a trouvé 2 autres bugs sur la macro UserForm_Initialize de UserForm5 :

'récupération données lignes
TextRow = ListBox1.ListIndex
strCol1 = ListBox1.List(TextRow, 3)

bug car ListBox1.ListIndex a la valeur -1, aucune ligne n'étant sélectionnée

TextBox2.Value = Sheets("USF5").Cells(4, 2).Value

bug car TextBox2 n'existe pas.

 

[patricktoulon]

 

[Bernard_XLD]

il est vrai que ça flashe de partout dès qu'on essaye de débugger un peu

 

[patricktoulon]

@Yeahou
et oui c'est bagdad ce truc

 

[Bernard_XLD]

voila, une fois débuggé, on trouve facilement la source du problème qui vient en fait, comme je l'ai dit de l'initialisation de TextRow et comme l'a dit Job75 non seulement de l'initialisation de textrow mais aussi de l'absence de textbox2.
pour le voir et avoir une erreur plus ciblée, lances des compilations de projet, supprimes les codes ou il manque le début de la procédure (il y en a trois ou quatre), désactive les appels de fonctions inexistantes (quatre si je me souviens bien), replace les déclarations publiques en début de module.
Une fois que ta compilation fonctionne sans erreur, les messages d'erreur en exécution sont plus faciles à traiter.
Plus qu'à désactiver les deux lignes concernées et ton Usf apparait !

 

[marc.gilliand]

Pouvez vous le faire pour moi. Car j'ai les yeux dilatés piur des examens de vue. Ça serait sympa.

 

[Bernard_XLD]

ok, je recharge ton fichier originel d'avant mes modifs

 

[Etoto]

re
pour te mettre le nez bien dedans puis qu’apparemment tu es plus préoccupé par des (vannes gentillettes) que ton problème et aussi à @Etoto pour sa culture (qui n'a rien trouvé )
alors je te met le nez dedans
en début de code tu fait

Me.ListBox1.RowSource = fplage.Address(external:=True)

et plus bas dans le code tu fait

ListBox1.List = Sheets("ListePaiements").Range("A1:K10000").Value

et ça ca n'est pas possible
une listebox en rowssource n'est plus modifiable tout le long de l'instance de l'affichage de ton userform
maintenant à la place du premier tu fait

Me.ListBox1.list= fplage.value

déjà ça fonctionnera un peu mieux
et je ne fait que survoler
j'irais pas plus loin ,tant que ton code dans le post 1 ne sera pas mis dans la balise code

Snif, je suis aveugle ou quoi ?? Bon au moins une erreur est résolue, je laisse le job aux autres pour éviter des dire des bêtises .

 

[patricktoulon]

@Etoto
ben tu apprends en même temps c'est bien
c'est pas difficile a retenir

.rowsource "PAS BIEN!!!!!!"
.list=uneplage.value "BIEN!!!!!"

 

[Etoto]

@Etoto
ben tu apprends en même temps c'est bien
c'est pas difficile a retenir

.rowsource "PAS BIEN!!!!!!"
.list=uneplage.value "BIEN!!!!!"

Alors si les cours de VBA sont comme ça, je prend direct , mais plus sérieusement vous avez appris le VBA comment ? (si je peux me le permettre).

 

[patricktoulon]

re
@Etoto
dans les forums(DVP,Exceldownloads,excelpratique,etc...
beaucoup d'heure de travail
moins de cheveux aujourd'hui
quelques

tout pleins de personnes gentilles et moins gentilles sur les forums

 

[Bernard_XLD]

Pouvez vous le faire pour moi. Car j'ai les yeux dilatés piur des examens de vue. Ça serait sympa.

voila ! j'ai fait un Xlsb, l'original en Xlsm ne passait pas chez moi, même compressé, tu as juste à le ré enregistrer en Xlsm

Bonne journée

 

[Etoto]

re
@Etoto
dans les forums(DVP,Exceldownloads,excelpratique,etc...
beaucoup d'heure de travail
moins de cheveux aujourd'hui
quelques
Regarde la pièce jointe 1107415
tout pleins de personnes gentilles et moins gentilles sur les forums

En résumé c'est le temps passé sur les forums ? Ok cool, dans 30 ans j'arriverais à faire une boucle .