Récupérer des données dans un autre classeur
Bonsoir, après des semaines de travail je dois rendre mon application demain, mais j'ai encore un gros bug sur un de mes formulaires (celui qui sert à récupérer les données de devis dans un autre classeur et remplir une facture à partir de ces devis). Je vous met ici le code que j'utilise dans ce formulaire et vous explique mes différents soucis :
Tout d'abord, Excel génère le message d’erreur suivant : Erreur d’éxécution 9. L’indice n’appartient pas à la sélection, quand je veux éxécuter le formulaire, sans toutefois m'indiquer d'où vient le problème
Private Sub UserForm_Initialize()
Dim j As Integer
Dim h As Integer
Dim k As Integer
'Remplissage des listbox :
For j = 3 To Sheets("BddClients").Range("A65536").End(xlUp).Row
With ListBox4
.AddItem Sheets("BddClients").Range("A" & j)
End With
Next j
For h = 2 To Sheets("FeuilCache").Range("L65536").End(xlUp).Row
With ComboBox1
.AddItem Sheets("FeuilCache").Range("L" & h)
End With
Next h
For k = 2 To Sheets("FeuilCache").Range("A65536").End(xlUp).Row
With ListBox2
.AddItem Sheets("FeuilCache").Range("A" & k)
End With
Next k
With ListBox3
.AddItem "19.6%"
.AddItem "5.5%"
End With
End Sub
Private Sub ListBox2_Click()
Dim i As Long
'Lie les deux listbox, donne les n° de devis correspondant à la commande choisie :
For i = 3 To 65536
If ListBox2.Value = Sheets("FeuilCache").Cells(i, 1).Value Then
ListBox1.Value = Sheets("FeuilCache").Cells(i, 12).Value
Exit For
End If
Next i
End Sub
Private Sub Combobox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim maFeuil As Integer
Sheets("FeuilCache").Activate
TextBox19.Text = Range("CoutMODCache").Item(Application.Match(ComboBox1.Value, Range("NoDevisCache"), 0))
TextBox20.Text = Range("CoutMatiereCache").Item(Application.Match(ComboBox1.Value, Range("NoDevisCache"), 0))
TextBox11.Text = Range("MontantFactCache").Item(Application.Match(ComboBox1.Value, Range("NoDevisCache"), 0))
TextBox13.Text = Range("MontantTTCCache").Item(Application.Match(ComboBox1.Value, Range("NoDevisCache"), 0))
Dans la procédure ci-dessus, le double clic sur l’item choisi dans la combobox doit récupérer les données correspondantes dans la feuille nommée FeuilCache et les afficher dans les textbox.
Problème ici : Excel génère un message d’erreur dès qu’on clique sur la combobox : incompatibilité de type.
Dim Worbk As Workbook
On Error Resume Next
Set Worbk = Workbooks("ArchivesFactures.xls")
On Error GoTo 0
If Worbk Is Nothing Then Workbooks.Open "C:\Users\Philippe\Documents\ArchivesFactures.xls" _
Else Set Worbk = Nothing
'Récupération des données du devis
On Error GoTo GestErreur
maFeuil = ComboBox1.Value
Sheets(maFeuil).Select
TextBox9.Text = Workbooks("ArchivesDevis").ActiveSheet.Cells(9, 3)
TextBox10.Text = Workbooks("ArchivesDevis").ActiveSheet.Cells(17, 1)
TextBox14.Text = Workbooks("ArchivesDevis").ActiveSheet.Cells(45, 2)
Exit Sub
GestErreur:
MsgBox "Cette feuille n'existe pas !"
End Sub
On doit ici récupérer les données dans un autre classeur, dans une feuille nommée par exemple DEVIS 2. Dans ce cas, quand on choisit l’item 2 dans la combobox, la feuille DEVIS 2 doit être activée, et les données qu’elle contient doivent s’afficher dans les textbox.
Private Sub ListBox4_Change()
'Affichage des infos dans les textbox suivant l'item sélectionné dans la listbox :
TextBox1.Value = Range("Adresse1").Item(Application.Match(ListBox4.Value, Range("NomClient"), 0))
TextBox2.Value = Range("Adresse2").Item(Application.Match(ListBox4.Value, Range("NomClient"), 0))
TextBox4.Value = Range("CPClient").Item(Application.Match(ListBox4.Value, Range("NomClient"), 0))
TextBox5.Value = Range("VilleClient").Item(Application.Match(ListBox4.Value, Range("NomClient"), 0))
TextBox18.Value = Range("PrenomClient").Item(Application.Match(ListBox4.Value, Range("NomClient"), 0))
End Sub
Private Sub CommandButton4_Click()
'Fonction date, affichage automatique de la date du jour :
TextBox17 = Format(Date, "Short Date")
End Sub
Private Sub ListBox3_Click()
'Calcul automatique du montant TTC en cliquant sur le taux de TVA :
If ListBox3.Value = "19.6%" Then
TextBox13.Value = Val(TextBox11.Value) * 1.196
Else
TextBox13.Value = Val(TextBox11.Value) * 1.055
End If
End Sub
Private Sub CommandButton1_Click()
'Fermeture du formulaire (bouton fermer):
Unload UserForm4
End Sub
Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Affiche le numéro auto de facture en double cliquant sur la textbox :
Worksheets("FacturesClients").Activate
Dim LeMaximum As Double
LeMaximum = WorksheetFunction.Max(Range("NoFact"))
TextBox6.Text = (LeMaximum + 1)
End Sub
Private Sub CommandButton3_Click()
Dim MontantHT As Variant
Dim MontantTTC As Currency
Dim NoFacture As Integer
MontantHT = TextBox11.Value
MontantTTC = TextBox13.Value
NoFacture = TextBox6.Value
'_____________________________________________________________________
' Désactivation de la mise à jour de l'écran :
Application.ScreenUpdating = False
Dim Cellule As Object
Dim Ctr As Long
For Each Cellule In Selection
Ctr = Ctr + 1
Cellule = Ctr
Next
' Réactivation de l'écran :
Application.ScreenUpdating = False
'____________________________________________________________________
'Ouverture du classeur ArchivesDevis s'il n'est pas déjà ouvert :
'Dim Worbk As Workbook
'On Error Resume Next
'Set Worbk = Workbooks("ArchivesFactures.xls")
'On Error GoTo 0
'If Worbk Is Nothing Then Workbooks.Open "C:\Users\Philippe\Documents\ArchivesFactures.xls" _
'Else Set Worbk = Nothing
'_____________________________________________________________________
'création et définition du nom d'une nouvelle feuille dans le classeur ArchivesFactures :
'Dim sht As Object
'On Error Resume Next
'Sheets("FACTURE N° ").Select
' ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
'On Error Resume Next
'For Each sht In ActiveWorkbook.Worksheets
' Sheets(sht.Name).Name = Sheets(sht.Name).[D12]
'Next
'_____________________________________________________________________
'Remplissage de la nouvelle feuille :
Workbooks("ArchivesFactures").ActiveSheet.Cells(12, 4) = "FACTURE N°" & " " & (NoFacture)
Workbooks("ArchivesFactures").ActiveSheet.Cells(2, 4) = ListBox4.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(3, 4) = TextBox1.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(4, 4) = TextBox2.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(5, 4) = (TextBox4.Text) & " " & (TextBox5.Text)
Workbooks("ArchivesFactures").ActiveSheet.Cells(16, 1) = ListBox2.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(19, 3) = TextBox7.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(20, 3) = TextBox8.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(22, 2) = "OBJET:" & " " & (TextBox9.Text)
Workbooks("ArchivesFactures").ActiveSheet.Cells(24, 2) = TextBox10.Text
Workbooks("ArchivesFactures").ActiveSheet.Cells(44, 2) = "REGLEMENT AU" & " " & (TextBox14.Text)
Workbooks("ArchivesFactures").ActiveSheet.Cells(38, 4) = TextBox16.Value
Workbooks("ArchivesFactures").ActiveSheet.Cells(38, 3) = TextBox15.Value
Workbooks("ArchivesFactures").ActiveSheet.Cells(43, 6) = MontantHT
Workbooks("ArchivesFactures").ActiveSheet.Cells(45, 6) = MontantTTC
Workbooks("ArchivesFactures").ActiveSheet.Cells(12, 1) = "Rezé le:" & " " & (TextBox17.Value)
'Sauvegarde et fermeture du classeur ArchivesFactures :
ActiveWorkbook.Save
ActiveWorkbook.Close
'_______________________________________________________________________
'Remplissage de FacturesClients! du classeur courant :
Dim LigneSuivante As Long
Dim Var As Integer
'Sheets("FacturesClients").Activate
' LigneSuivante = ThisWorkbook.Worksheets(4).Cells(3, 1).CurrentRegion.Rows.Count
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 1) = TextBox17
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 2) = NoFacture
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 3) = ListBox2
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 4) = ListBox4
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 5) = MontantHT
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 6) = MontantTTC
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 8) = TextBox20
' ThisWorkbook.Worksheets(3).Cells(LigneSuivante, 9) = TextBox19
‘Remplissage d’une feuille de transition (FeuilCache) sur la même ligne que les données concernant la commande qui y sont déjà :
' Var = Cells("C3").End(xlDown).Value
'Sheets("FeuilCache").Activate
'Cells.Find(What:=(Var), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder _
':=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
'ActiveCell.Offset(0, 13) = Range("FacturesClients!C3.end(xldown)").Value
'ActiveCell.Offset(0, 2) = TextBox8.Value
'ActiveCell.Offset(0, 3) = TextBox9.Value
'ActiveCell.Offset(0, 4) = TextBox10.Value
'ActiveCell.Offset(0, 5) = TextBox11.Value
'Calcul de la TVA collectée :
Range("G3").End(xlDown).Activate
ActiveCell.FormulaR1C1 = "(RC(-2)) - (RC(-1))"
'Affichage de l'année de la facture :
Range("K3").End(xlDown).Activate
ActiveCell.FormulaR1C1 = "=YEAR(RC[-12])"
'Affichage du mois de la facture :
Range("L3").End(xlDown).Activate
ActiveCell.FormulaR1C1 = "=MONTH(RC[-13])"
If ActiveCell.Value = 1 Then ActiveCell.Value = "Janvier"
If ActiveCell.Value = 2 Then ActiveCell.Value = "Février"
If ActiveCell.Value = 3 Then ActiveCell.Value = "Mars"
If ActiveCell.Value = 4 Then ActiveCell.Value = "Avril"
If ActiveCell.Value = 5 Then ActiveCell.Value = "Mai"
If ActiveCell.Value = 6 Then ActiveCell.Value = "Juin"
If ActiveCell.Value = 7 Then ActiveCell.Value = "Juillet"
If ActiveCell.Value = 8 Then ActiveCell.Value = "Août"
If ActiveCell.Value = 9 Then ActiveCell.Value = "Septembre"
If ActiveCell.Value = 10 Then ActiveCell.Value = "Octobre"
If ActiveCell.Value = 11 Then ActiveCell.Value = "Novembre"
If ActiveCell.Value = 12 Then ActiveCell.Value = "Décembre"
'_______________________________________________________________________
'Suppression de la ligne correspondant à cette facture dans FeuilCache :
Dim Var
Dim NumLg
On Error Resume Next
Sheets("FeuilCache").Activate
Var = TextBox6.Value
Cells.Find(What:=(Var), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder _
:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
With Application.ActiveCell
NumLg = .Row
End With
ActiveCell.EntireRow.Select
Style = vbYesNo + vbDefaultButton1
Msg = "Suppression de la ligne N°: " & NumLg
Title = "Attention suppression de la ligne"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
Selection.Delete Shift:=xlUp
Else
Exit Sub
End If
'Redimensionnement de la plage de cellules
ActiveSheet.UsedRange
End Sub
'_____________________________________________________________________
Private Sub CommandButton5_Click()
'réinitialisation du formulaire avant nouvelle saisie :
ListBox4.Value = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
ListBox2.Value = ""
TextBox17.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox14.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox11.Text = ""
TextBox13.Text = ""
End Sub
J'en profite pour vous remercier de votre aide car vos réponses à mes questions m'ont été très précieuses durant ce travail.
- Messages
- 1'036
- Excel
- 2003 FR / 2007 UK
- Inscrit
- 07/05/2007
- Emploi
- Consultant en finance
A voir comme ça, ça donne pas trop envie... n'as tu pas une ligne jaune quand excel te mets une erreur ?
C dans quelle macro ? il y en a je sais pas combien là... s'il faut tout analyser...
A+
Souri84
Bonsoir,
je rejoins souri84, des codes ainsi présentés, sont incompréhensibles.....
De plus, je vois que tu as le temps de poser des questions, mais que celui-ci (le temps) t'est compté pour donner suite aux solutions proposées sur tes anciens fils.....
Si tu es dans le même projet, réponds tout d'abord aux fils précédents, et ensuite, pour pouvoir te répondre, de manière satisfaisante, il faudrait quelques données de plus....