ListBox et copies Cellules

[roby]

bonjour le Forum,

La commande "Valider" n'arrive pas à mettre à jour certaines cellules de la feuille, pourtant les TextBox8 à TextBox11 sont bien renseignées dans la boite de dialogue.

ci-dessous le code:

Private Sub ComboBox1_Change() Correspond à un choix
'Cherche MU
'----------
Dim L3 As Integer
Dim ReCherche, LRecherche As String
Dim Plage3 As Range
Application.ScreenUpdating = False
Sheets("Dispositifs").Activate
ReCherche = APPSMJ.ComboBox1.Value
L3 = Sheets("Dispositifs").Range("F65536").End(xlUp).Row
Set Plage3 = Sheets("Dispositifs").Range("F9:F" & L3)
For Each Cell In Plage3
If Cell.Value = ReCherche Then
LRecherche = Cell.Row
Cell.Select
End If
Next Cell
APPSMJ.TextBox8.Value = Selection.Offset(0, 1).Value Les données recherchées
APPSMJ.TextBox9.Value = Selection.Offset(0, 2).Value
APPSMJ.TextBox10.Value = Selection.Offset(0, 3).Value
APPSMJ.TextBox11.Value = Selection.Offset(0, 4).Value
If Selection.Offset(0, 5).Value = "PSE" Then
APPSMJ.OptionButton5 = True
Else
APPSMJ.OptionButton4 = True
End If
Sheets("PPSMJ").Activate
Application.ScreenUpdating = True
APPSMJ.CommandButton1.SetFocus
End Sub

Private Sub CommandButton1_Click()
'Valider
'-------
Dim L1, L2, n As Integer
Dim Plage2 As Range
APPSMJ.CommandButton3.Enabled = True
If APPSMJ.TextBox1 = "" Then
MsgBox "ATTENTION, vous n'avez saisie aucune donnée !", vbCritical, "Saisie incomplète": Unload Me
On Error Resume Next: Err.Clear
End If
If Choix = 1 Then
L1 = Sheets("PPSMJ").Range("C65536").End(xlUp).Row + 1
Else
L1 = NomLBindex1
End If
With Sheets("PPSMJ")
.Range("A" & L1).Value = APPSMJ.TextBox1.Value
.Range("C" & L1).Value = APPSMJ.TextBox3.Value
.Range("D" & L1).Value = APPSMJ.TextBox4.Value
.Range("E" & L1).Value = APPSMJ.TextBox5.Value
.Range("F" & L1).Value = APPSMJ.TextBox6.Value
.Range("G" & L1).Value = APPSMJ.TextBox7.Value
If APPSMJ.OptionButton1 = True Then
.Range("H" & L1).Value = "H" 'Homme
End If
If APPSMJ.OptionButton2 = True Then
.Range("H" & L1).Value = "F" 'Femme
End If
If APPSMJ.OptionButton3 = True Then
.Range("H" & L1).Value = "M" 'Mineur
End If

.Range("I" & L1).Value = APPSMJ.ComboBox1.Value c'est ici qu'il ne veut pas copier
.Range("J" & L1).Value = APPSMJ.TextBox8.Value
.Range("K" & L1).Value = APPSMJ.TextBox9.Value
.Range("L" & L1).Value = APPSMJ.TextBox10.Value
.Range("M" & L1).Value = APPSMJ.TextBox11.Value

If APPSMJ.OptionButton5 = True Then
.Range("N" & L1).Value = "PSE"
Else
.Range("N" & L1).Value = "PSEM"
End If
End With

For n = 1 To 7
APPSMJ.Controls("TextBox" & n) = ""
Next n
APPSMJ.ComboBox1 = ""
For n = 8 To 11
APPSMJ.Controls("TextBox" & n) = ""
Next n
APPSMJ.OptionButton4 = False
APPSMJ.OptionButton5 = False
'Mise à jour - Dispositifs -> Dispo "N"
Application.ScreenUpdating = False
Sheets("Dispositifs").Activate
ReCherche = APPSMJ.ComboBox1.Value
L2 = Sheets("Dispositifs").Range("B65536").End(xlUp).Row
Set Plage2 = Sheets("Dispositifs").Range("F9:F" & L2)
For Each Cell In Plage2
If Cell.Value = ReCherche Then
LRecherche = Cell.Row
Cell.Select
End If
Next Cell
Selection.Offset(0, 6).Value = "N"
Sheets("PPSMJ").Activate
Application.ScreenUpdating = True
APPSMJ.CommandButton3.Enabled = True
APPSMJ.CommandButton3.SetFocus

End Sub

 

[kjin]

Re : ListBox et copies Cellules

Bonsoir,
Euh...oui...c'est grave docteur ?! 🙄
A+...avec un fichier, peut-être...
kjin

 

[roby]

Re : ListBox et copies Cellules

bonsoir Kjin

je suis désolé mais le fichier est un peu gros.

bonne soirée

 

[Habitude]

Re : ListBox et copies Cellules

Je sérais porté à remplacer

.Range("J" & L1).Value = APPSMJ.TextBox8.Value
.Range("K" & L1).Value = APPSMJ.TextBox9.Value
.Range("L" & L1).Value = APPSMJ.TextBox10.Value
.Range("M" & L1).Value = APPSMJ.TextBox11.Value

par

.Range("J" & L1).Value = APPSMJ.TextBox8.Text
.Range("K" & L1).Value = APPSMJ.TextBox9.Text
.Range("L" & L1).Value = APPSMJ.TextBox10.Text
.Range("M" & L1).Value = APPSMJ.TextBox11.Text

 

[roby]

Re : ListBox et copies Cellules

Re Bonsoir le forum, Habitude et Kjin


Ci-joint un morceau du code avec les PB commentés.

merci d'avance.

 

[kjin]

Re : ListBox et copies Cellules

bonsoir,
Ton fichier a comme un petit pb
A+
kjin

 

[roby]

Re : ListBox et copies Cellules

Re

je vais reessayer de suite, desole

A+

 

[kjin]

Re : ListBox et copies Cellules

Bonsoir,
Pour info le fichier est ICI
A+
kjin

 

[roby]

Re : ListBox et copies Cellules

Re Forum

Merci Kjin

Pas trop bien compris pour le lien, pourtant copier comme indique.

A+

 

[kjin]

Re : ListBox et copies Cellules

Bonsoir,
Ton fichier corrigé en PJ
Note que comme je n'ai pas compris l'interaction entre les 2 feuilles, je me suis contenté de faire du ménage sans chercher à optimiser
J'ai allégé le fichier pour le poster directement sur le forum
A+
kjin

 

[roby]

Re : ListBox et copies Cellules

Bonjour le Forum, KJin

Je teste ton fichier ce soir, et je te tiens au courant.
je te remercie d'avance du temps que tu as consacresur mon soucis.

A+

 

[roby]

Re : ListBox et copies Cellules

bonsoir le Forum, KJin

j'ai transcris ton code sur mon fichier d'origine et une erreur s'est affichee lorsque je clic sur le bouton Gestion.

erreur d'execution 70
Permission refusée


je ne sais pas pourquoi ?
sais tu ou cela pourrait provenir, j'ai recontrole le code c'est le meme que le tien

a te relire

A+

 

[kjin]

Re : ListBox et copies Cellules

Re,
A+
kjin

 

[kjin]

Re : ListBox et copies Cellules

Re,
As tu effacé la propriété RowSource des combos ? (fenêtre propriétés)
A+
kjin

 

[roby]

Re : ListBox et copies Cellules

Re le Forum, Kjin

je n'ai rien efface, je ne comprend pas cette erreur.

A+
Roby