abtony
XLDnaute Impliqué
Bonjour a tous, bonjour le forum,
Je bute sur un projet et je ne sais pas si cela est possible.
Sur l'userform, choix suivi SAV, dans la combobox choix en cour.
a partir de la on a une liste sur la listbox, est il possible de faire des choix multiple pour chaque ligne, transférer sur la feuille Fiche SAV et imprimer chaque ligne de la sélection multiple l'une après l'autre ?
je ne vois pas du tout comment faire, pour cela je sollicite votre aide.
Merci par avance
Cordialement
Abtony
le code de transfert feuille est fait je joint ci-dessous
Je bute sur un projet et je ne sais pas si cela est possible.
Sur l'userform, choix suivi SAV, dans la combobox choix en cour.
a partir de la on a une liste sur la listbox, est il possible de faire des choix multiple pour chaque ligne, transférer sur la feuille Fiche SAV et imprimer chaque ligne de la sélection multiple l'une après l'autre ?
je ne vois pas du tout comment faire, pour cela je sollicite votre aide.
Merci par avance
Cordialement
Abtony
le code de transfert feuille est fait je joint ci-dessous
VB:
Private Sub CommandButton5_Click()
'Déclaration des feuilles
Set wsp = Worksheets("Fiche Pose")
Set wsa = Worksheets("Archives")
Set wss = Worksheets("Fiche SAV")
Dim Msg As String, Style As String, Title As String, Answer As String
Msg = "Voulez vous remplir la fiche SAV?" ' Définit le message.
Style = vbYesNo + vbQuestion ' Définit les boutons.
Title = "Validation Fiche SAV" ' Définit les titres.
Answer = MsgBox(Msg, Style, Title)
If Answer = vbYes Then ' bouton Oui.
wss.Activate
Application.ScreenUpdating = True
'Rangement feuille fiche de pose
wss.Cells(1, 5) = TextBox1 & " " & TextBox2
wss.Cells(3, 6) = TextBox3
'wsp.Cells(18, 2) = TextBox4
wss.Cells(5, 6) = TextBox5
wss.Cells(5, 7) = TextBox6
wss.Cells(7, 8) = TextBox7
wss.Cells(9, 8) = TextBox9
wss.Cells(14, 2) = ComboBox3
wss.Cells(14, 6) = ComboBox4
wss.Cells(18, 2) = TextBox18
wss.Cells(32, 2) = TextBox19
wss.Cells(51, 6) = ComboBox5
wss.Cells(55, 5) = TextBox20
wss.Cells(58, 6) = ComboBox2
End If
Application.ScreenUpdating = False
Msg = "Voulez vous archiver la fiche ?" ' Définit le message.
Style = vbYesNo + vbQuestion ' Définit les boutons.
Title = "Archivage" ' Définit les titres.
Answer = MsgBox(Msg, Style, Title)
If Answer = vbYes Then ' bouton Oui.
Dim ligne
Set zz = wsa.Columns(15).Find(What:=TextBox15.Value)
If zz Is Nothing Then
Set zz = wsa.Cells(65500, 15).End(xlUp).Offset(1, 0)
Else
If Not MsgBox(MSGNREXISTF, vbQuestion + vbYesNo) = vbYes Then Exit Sub
End If
ligne = TextBox15.Value + 1
'For x = 1 To 9
'For i = 13 To 17
wsa.Cells(ligne, 19).Value = ComboBox2.Value
wsa.Cells(ligne, 20).Value = ComboBox3.Value
wsa.Cells(ligne, 21).Value = ComboBox4.Value
wsa.Cells(ligne, 22).Value = TextBox18.Value
wsa.Cells(ligne, 23).Value = TextBox19.Value
wsa.Cells(ligne, 24).Value = ComboBox5.Value
wsa.Cells(ligne, 25).Value = TextBox20.Value
wsa.Cells(ligne, 26).Value = TextBox21.Value
wsa.Cells(ligne, 27).Value = TextBox22.Value
wsa.Cells(ligne, 28).Value = TextBox23.Value
wsa.Cells(ligne, 29).Value = ComboBox6.Value
'Next i
'Next x
If Answer = vbNo Then Exit Sub
End If
For y = 1 To 23
For n = 1 To 6
Controls("textbox" & y) = ""
Controls("ComboBox" & n) = ""
Next n
Next y
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
sav.Value = False
End Sub
Pièces jointes
Dernière édition: