Probleme inportation donnée de combobox dans ligne
Bonjour à toutes et tous
Je n'y connaît pas grand chose en vba mais j'essai depuis
deux jours de résolver un gros problème alors désolé si il y a déjà eu du similaire
mais j'arrive pas à trouver
Quand je valide les données de mon userform, celle-ci vont bien la ou je veux,
mais si je veux rajouté une ligne, ces dernières données vont au dessus alors que je voudrai
quelles ailles dessous les précédentes entrées.
En gros, à chaque validation de donnée j'ai bien une ligne qui sajoute mais les données ne suivent pas
Dond là, ça me fait faire mais devis et facture à l'envers.
Merci d'avance à ceux qui pourront me donner un coups de main.
[Private Sub CommandButton1_Click()
If TextBox5.Value = "" Then
MsgBox "Vous avez sélectionner un travail sans prix !"
Exit Sub
Else
If Worksheets("modele").Range("i2").Value = 13 Then
Unload UserForm1
Sheets("modele").Select
MsgBox "Devis complet !"
Exit Sub
Else
num = TextBox7.Value
If Not IsNumeric(num) Then
MsgBox "Vous devez saisir une quantité !"
TextBox7.Value = ""
TextBox7.SetFocus
Exit Sub
Else
Dim prix As Currency
prix = TextBox5.Value
prix = Format(prix, "0.00")
'Worksheets("modele").Range("b26").End(xlUp).Offset(1, 0) = ListBox2.Value 'designation
'Worksheets("modele").Range("e26").End(xlUp).Offset(1, 0) = TextBox7.Value 'qté
'Worksheets("modele").Range("i26").End(xlUp).Offset(1, 0) = TextBox1.Value 'unité
'Worksheets("modele").Range("h26").End(xlUp).Offset(1, 0) = prix 'prix ht
Sheets("modele").Rows("14:14").Insert Shift:=xlDown
Sheets("modele").Rows("14:14").Interior.ColorIndex = xlNone
Worksheets("modele").Range("b14") = ListBox2.Value 'designation
Worksheets("modele").Range("e14") = TextBox7.Value 'qté
Worksheets("modele").Range("D14") = TextBox1.Value 'unité
Worksheets("modele").Range("C14") = prix 'prix ht
Sheets("modele").Select
Rows("14:14").RowHeight = 35
Range("B14:E14").Select
Selection.Font.Bold = False
Range("B14:E14").Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With
Range("B14").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("F14").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",SUM(RC[-3]*RC[-1]))"
Range("B14:F14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C14").Select
Selection.NumberFormat = "General"
Range("a1").Select
MsgBox ("Travaux ajouté sur modele")
fe = TextBox6.Value
Sheets(fe).Select
TextBox1 = ""
TextBox5 = ""
TextBox7 = ""
End If
End If
End If
End Sub ]
bonjour nicoxlsm
si tu joint un fichier tu aura plus de réponse et en plus pour mettre un code en ligne tu clic sur le bouton "code"
déja en enlevant tout les select et activate tu éclaircirait ton code voici un exemple tiré de ton code
With Sheets("modele")
.Rows("14:14").RowHeight = 35
.Range("B14:E14").Font.Bold = False
With .Range("B14:E14").Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With
With .Range("B14")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
End Withet je sais qu'un pro peut même faire mieux
pascal
bonsoir nicoxlsm
essaie cette version non testée car pas de fichier
Private Sub CommandButton1_Click()
Dim lig As Integer
If TextBox5.Value = "" Then
MsgBox "Vous avez sélectionner un travail sans prix !"
Exit Sub
Else
If Worksheets("modele").Range("i2").Value = 13 Then
Unload UserForm1
With Sheets("modele")
MsgBox "Devis complet !"
Exit Sub
Else
lig = .Range("B65536").End(xlUp)(2).Row
If lig < 19 Then lig = 19
num = TextBox7.Value
If Not IsNumeric(num) Then
MsgBox "Vous devez saisir une quantité !"
TextBox7.Value = ""
TextBox7.SetFocus
Exit Sub
Else
Dim prix As Currency
prix = .TextBox5.Value
prix = .Format(prix, "0.00")
'Worksheets("modele").Range("b26").End(xlUp).Offset(1, 0) = ListBox2.Value 'designation
'Worksheets("modele").Range("e26").End(xlUp).Offset(1, 0) = TextBox7.Value 'qté
'Worksheets("modele").Range("i26").End(xlUp).Offset(1, 0) = TextBox1.Value 'unité
'Worksheets("modele").Range("h26").End(xlUp).Offset(1, 0) = prix 'prix ht
With .Rows("14:14" & lig)
.Insert Shift:=xlDown
.Rows("14:14").Interior.ColorIndex = xlNone
End With
.Range("B14 & lig") = ListBox2.Value 'designation
.Range("E14 & lig") = TextBox7.Value 'qté
.Range("D14 & lig") = TextBox1.Value 'unité
.Range("C14 & lig") = prix 'prix ht
.Rows("14:14").RowHeight = 35
.Range("B14:E14").Font.Bold = False
With .Range("B14:E14").Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With
With .Range("B14")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
End With
.Range("F14").FormulaR1C1 = "=IF(RC[-3]="""","""",SUM(RC[-3]*RC[-1]))"
.Range("B14:F14").Borders.LineStyle = 1
.Range("C14").NumberFormat = "General"
.Range("a1").Select
MsgBox ("Travaux ajouté sur modele")
fe = TextBox6.Value
Sheets(fe).Select
TextBox1 = ""
TextBox5 = ""
TextBox7 = ""
End If
End If
End If
End Subtu peux modifié le début d'inscription
If lig < 19 Then lig = 19tu n'est pas obliger de garder 19
Pascal
bonjour Nicolxlsm
tu t'es perdu pour ne plus te manifester ou tu ne veux pas nous dire d'où tu tiens ce code car j'ai le même classeur dans mes archives et qui se nomme "facturemaconnerie" édité par Robert rené qui a protéger ses codes par un mot de passe, même si le classeur fonctionne après avoir été validé par un appel chez "allopass"
d'ailleurs je joints le classeur de Robert René si les modérateurs veulent comparer si c'est comparable
Pascal
Bonjour
merci pour ta remarque mais c'est un fichier récupéré par hasard sur le net, je voulais essayer de le modifier pour travailler avec,
mais j'avoue que c'est un peu trop compliqué pour moi le vba,
merci quand même pour vos message envoyé c'est gentil
Nicolas.