Adapter VBA sur nouvelle page
Bonjour,
Grâce à l'aide que vous m'avez déjà apportée (cf. sujet précédent Récupérer un nom dans une liste), j'ai bien avancé dans mon projet.
Mais maintenant, je voudrais, sur le modèle de la feuille "Résultats", créer 2 feuilles "Hunter" et "Loisir" - ce sont 2 disciplines différentes à l'intérieur du Tir sportif. A terme, je supprimerai la feuille "Résultats" et son annexe-R.
J'ai essayé de créer le code pour la feuille Loisir et sa macro spécifique, mais je n'arrive pas à adapter le code, car Excel me renvoie des messages d'erreur à propos des noms Lig etc...
Je joins mon fichier en l'état, et je vous remercie d'avance pour vos explications. Sachant que je ferai ensuite de ce fichier un Modèle pour en tirer une nouvelle mouture à chaque nouvelle compét.
Bonne soirée
PS : fichier trop lourd, si vous m'indiquez un autre moyen de vous le faire parvenir, je le ferai.
Bonsoir,
tu peu poster ton code "fautif" sur le forum , en utilisant le bouton Code au dessus de la boite de saisie de messages ...
et nous rapporter ici les messages d'erreurs ...
Merci,
donc voici le code pour la feuille "Résultats", qui marchait très bien tant qu'elle était toute seule :
Private Sub CmdOK_Click()
'
ActiveSheet.[g2] = ""
If Me.TxtParticipants.Text = "" Then
Me.LblTireur.Caption = ""
ActiveSheet.[f2] = "TAPER ICI LES PREMIERES LETTRES DU NOM"
Exit Sub
End If
'
If Me.LblTireur.Caption <> "" Then Call Afficher
'
End Sub
Private Sub TxtParticipants_Change()
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtParticipants.Text
iFlag = Range("B" & Rows.Count).End(xlUp).Row
iFlag1 = Worksheets("Tireurs").Range("A" & Rows.Count).End(xlUp).Row
'
iTestENTER = 0
'
If Me.TxtParticipants.Text = "" Then
Me.LblTireur.Caption = ""
Exit Sub
End If
'
If Asc(Right$(sFlag, 1)) = 43 Then
' Si TextParticipants est vide
If Len(sFlag) = 1 Then
Me.TxtParticipants.Text = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
Exit Sub
End If
iTestENTER = 1
sFlag = Left$(sFlag, Len(sFlag) - 1)
End If
'
For Lig = 1 To iFlag1
If LCase$(sFlag) = LCase$(Left$(Worksheets("Tireurs").Range("C" & Lig).Value, Len(sFlag))) Then
If iTestENTER = 0 Then
sFlag = Worksheets("Tireurs").Range("A" & Lig).Value
Me.LblTireur.Caption = sFlag
Else
Call Afficher
End If
Exit For
Else
Me.LblTireur.Caption = ""
End If
Next
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("c5:c120")) Is Nothing Then
ActiveCell.Offset(1, 0).Range("A1").Select
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").[g2] = "NOM SUIVANT ?"
Worksheets("Résultats").Range("c5:c120").Interior.ColorIndex = 0
End If
End SubEt le code "adapté" pour la feuille LOISIR :
Private Sub OKL_Click()
'
ActiveSheet.[g2] = ""
If Me.TxtL.Text = "" Then
Me.LblL.Caption = ""
ActiveSheet.[f2] = "TAPER ICI LES PREMIERES LETTRES DU NOM"
Exit Sub
End If
'
If Me.LblL.Caption <> "" Then Call AfficherLOISIR
'
End Sub
Private Sub TxtL_Change()
Worksheets("LOISIR").[f2] = ""
Worksheets("LOISIR").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtL.Text
iFlag = Range("B" & Rows.Count).End(xlUp).Row
iFlag1 = Worksheets("Tireurs").Range("A" & Rows.Count).End(xlUp).Row
'
iTestENTER = 0
'
If Me.TxtL.Text = "" Then
Me.LblL.Caption = ""
Exit Sub
End If
'
If Asc(Right$(sFlag, 1)) = 43 Then
' Si TxtL est vide
If Len(sFlag) = 1 Then
Me.TxtL.Text = ""
Worksheets("LOISIR").Range("k2:m2").Interior.ColorIndex = 0
Exit Sub
End If
iTestENTER = 1
sFlag = Left$(sFlag, Len(sFlag) - 1)
End If
'
For LigL = 1 To iFlag1
If LCase$(sFlag) = LCase$(Left$(Worksheets("Tireurs").Range("C" & LigL).Value, Len(sFlag))) Then
If iTestENTER = 0 Then
sFlag = Worksheets("Tireurs").Range("A" & LigL).Value
Me.LblL.Caption = sFlag
Else
Call AfficherLOISIR
End If
Exit For
Else
Me.LblL.Caption = ""
End If
Next
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("c5:c120")) Is Nothing Then
ActiveCell.Offset(1, 0).Range("A1").Select
Worksheets("LOISIR").[f2] = ""
Worksheets("LOISIR").[g2] = "NOM SUIVANT ?"
Worksheets("LOISIR").Range("c5:c120").Interior.ColorIndex = 0
End If
End SubLa Macro "Afficher" pour la feuille "Résultats":
Public Lig As Integer
Public Sub Afficher()
'
' Remettre un fond incolore aux cellules k2:m2
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
iFlag = Worksheets("Résultats").Range("B" & Rows.Count).End(xlUp).Row
'
iRow = IIf(Worksheets("Résultats").[J1] = "", iFlag + 1, Worksheets("Résultats").[J1])
Worksheets("Résultats").Range("B" & iRow).Interior.Color = xlNone
Worksheets("Tireurs").Range("A" & Lig).Copy Destination:=Worksheets("Résultats").Range("B" & iRow)
Worksheets("Résultats").[J1] = ""
Worksheets("Résultats").LblTireur.Caption = ""
Worksheets("Résultats").TxtParticipants.Text = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
If Worksheets("Résultats").Range("c" & iRow) = "" Then
Worksheets("Résultats").Range("c" & iRow).Select
Worksheets("Résultats").[f2] = "Sélectionner le Prénom dans la liste"
Worksheets("Résultats").Range("c" & iRow).Interior.ColorIndex = 6
Exit Sub
End If
'
End SubEt la macro adaptée "AfficherLoisir" :
Public Lig As Integer
Public Sub AfficherLOISIR()
'
' Remettre un fond incolore aux cellules k2:m2
Worksheets("LOISIR").Range("k2:m2").Interior.ColorIndex = 0
iFlag = Worksheets("LOISIR").Range("B" & Rows.Count).End(xlUp).Row
'
iRow = IIf(Worksheets("LOISIR").[J1] = "", iFlag + 1, Worksheets("LOISIR").[J1])
Worksheets("LOISIR").Range("B" & iRow).Interior.Color = xlNone
Worksheets("Tireurs").Range("A" & LigL).Copy Destination:=Worksheets("LOISIR").Range("B" & iRow)
Worksheets("LOISIR").[J1] = ""
Worksheets("LOISIR").LblL.Caption = ""
Worksheets("LOISIR").TxtL.Text = ""
Worksheets("LOISIR").Range("k2:m2").Interior.ColorIndex = 0
If Worksheets("LOISIR").Range("c" & iRow) = "" Then
Worksheets("LOISIR").Range("c" & iRow).Select
Worksheets("LOISIR").[f2] = "Sélectionner le Prénom dans la liste"
Worksheets("LOISIR").Range("c" & iRow).Interior.ColorIndex = 6
Exit Sub
End If
'
End SubDonc, depuis que j'ai ajouté ces nouveaux codes, j'obtiens sur la feuille Résultats, en cliquant sur le bouton OK, le message d'erreur:
"Erreur de compilation, nom ambigu détecté", avec surlignement du mot "Lig" dans le code de feuille-1, au niveau de For Lig = 1 To iFlag1 ; je ne peux pas savoir pour la suite, car je suis bloquée par ce message.
Mais sur la feuille 8 = Loisir, toujours en cliquant sur son bouton OK, j'obtiens le message d'erreur : "Erreur d'exécution 1004, définie par l'application ou l'objet". En cliquant sur le débogage, je trouve cette ligne surlignée - dans la macro AfficherLoisir : Worksheets("Tireurs").Range("A" & LigL).Copy Destination:=Worksheets("LOISIR").Range("B" & iRow).
Pareil, je ne peux pas en savoir plus...
Et je n'ai pas encore essayé de le faire pour le dernier ensemble "Hunter" !!!
Merci d'avance
Bonsoir Mimouch,
passe par CJOINT.COM y créer un lien vers ton fichier puis colle ce lien dans un nouveau message.
Ce sera plus facile pour ceux qui voudront participer!
A+
Bonjour,
des problèmes avec ta/tes variable publique ilG ... que tu déclare à plusieurs endroits , et que tu as commencé as renommé dans ton afficheLoisir mais tu n'as pas terminé...
évite l'utilisation des variables globales , dans ton cas tu peu très bien passé le numéro de ligne en paramètre de tes fonctions affiche..
tu supprime les lignes :
Public Lig As Integertu modifie la déclaration de tes fonctions affiche :
Public Sub Afficher(Lig As Integer)Public Sub AfficherLOISIR(LigL as integer)(LigL puisque tu as commencé as renommer cette variable dans le reste de ton code ...
et lors de te l'appel de tes fonctions tu passe le numéro de ligne en paramètre
(..)
Dim i as integer 'Pensez à déclarer toutes tes variables
(...)
For i= 1 To iFlag1
If LCase$(sFlag) = LCase$(Left$(Worksheets("Tireurs").Range("C" & i).Value, Len(sFlag))) Then
If iTestENTER = 0 Then
sFlag = Worksheets("Tireurs").Range("A" & i).Value
Me.LblL.Caption = sFlag
Else
AfficherLOISIR i
(...)tu utilise beaucoup de variables sans les déclarer, cela est source de problème , une bonne pratique as tenir et de rajouter en haut de tous tes codes la ligne :
Option Explicitce qui interdit l’exécution du code si une variable n'est pas déclaré , et par exemple dans ton cas cela aurait mis en évidence ton oubli de la déclaration de ta variable iLgL..
dis nous déjà si ton code fonctionne mieux avec ces corrections...
je n'ais pas regardé en détail mais si la seule différence entre tes deux fonctions et la feuille de destination tu aussi passer cette feuille en paramètre de ta fonction et ainsi n'utiliser qu'une seule fonction...
Nouvelle déclaration de ta fonction :
Public Sub Afficher(Lig As Integer, sh as worksheet)utilisation de de sh , la feuille destination dans ton code :
(...)
'iFlag = Worksheets("Résultats").Range("B" & Rows.Count).End(xlUp).Row
'== devient :
iFlag = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
(...)et pour l'appel :
(... )
Afficher i, Worksheets("Résultats")
(...)Bonjour,
Je n'ai pas du tout comprendre, c'est le moins qu'on puisse dire. Il faut dire que je n'y connais rien, je me contente de bidouiller à partir des codes obligeamment envoyés via le forum...
Bref, j'ai apporté les modifications indiquées, sauf le regroupement sur une seule fonction Afficher (je trouve bizarre que l'appel soit Afficher i, Worksheets("Résultats"), si cette macro doit fonctionner pour plusieurs feuilles).
Mais je n'ai peut-être pas mis tes corrections au bon endroit, car maintenant j'ai le message (que ce soit à partir de la feuille Résultats ou Loisir) : "Erreur de compilation Variable non définie", avec le sFlag sélectionné :
Private Sub TxtL_Change()
Worksheets("LOISIR").[f2] = ""
Worksheets("LOISIR").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtL.Text
Je suis assez paumée, désolée pour le boulet
Bonjour,
Sans intervenir dans le débat, pour te faire gagner un peu de temps le cas échéant, tu as deux procédures identiques, pour Résultat et pour Loisirs. Il es raisonnable de n'en faire qu'une !
En l'appelant pour Résultat, tu lui passes en argument la feuille Résultat. En l'appelant pour Loisir, tu lui passes la feuille Loisir. On a ainsi un code modulaire, plus compact et plus efficace.
Cordialement.
Bonjour,
Ah, si je comprends bien, on mettra Wksht Résultats depuis cette feuille ou Wksht Loisir depuis la feuille Loisir (je rappelle que je ne m'y connais pas du tout, mais qd on m'explique tout détaillé j'arrive à comprendre). OK.
Merci
Reste que mes codes ne fonctionnent pas parce que j'ai du les mettre en vrac.
Salut,
J'ai essayé maintenant en mettant une seule macro commune à plusieurs feuilles, mais je suis toujours bloquée par de multiples messages d'erreur
- en cliquant sur OK : si la TxtParticipants est vide, ça fonctionne, sinon: "Erreur d'exécution 1004" ; dans le débogage, la ligne surlignée dans le module est :
Worksheets("Tireurs").Range("A" & Lig).Copy Destination:=Worksheets("Résultats").Range("B" & iRow)
Ou bien j'ai encore "erreur variable non définie" sur le "sFlag" dans la code de la feuille1:
Private Sub TxtParticipants_Change()
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtParticipants.Text
Bonjour,
Pour bien me faire comprendre, voilà le code tel que je l'ai modifié
- pour la macro "Afficher" :
Public Sub Afficher(Lig As Integer, sh As Worksheet)
'
' Remettre un fond incolore aux cellules k2:m2
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
iFlag = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
'
iRow = IIf(Worksheets("Résultats").[J1] = "", iFlag + 1, Worksheets("Résultats").[J1])
Worksheets("Résultats").Range("B" & iRow).Interior.Color = xlNone
Worksheets("Tireurs").Range("A" & Lig).Copy Destination:=Worksheets("Résultats").Range("B" & iRow)
Worksheets("Résultats").[J1] = ""
Worksheets("Résultats").LblTireur.Caption = ""
Worksheets("Résultats").TxtParticipants.Text = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
If Worksheets("Résultats").Range("c" & iRow) = "" Then
Worksheets("Résultats").Range("c" & iRow).Select
Worksheets("Résultats").[f2] = "Sélectionner le Prénom dans la liste"
Worksheets("Résultats").Range("c" & iRow).Interior.ColorIndex = 6
Exit Sub
End If
'
End SubEt pour la Feuille-1 "Résultats":
Option Explicit
Private Sub CmdOK_Click()
'
Dim i As Integer 'Pensez à déclarer toutes tes variables
ActiveSheet.[g2] = ""
If Me.TxtParticipants.Text = "" Then
Me.LblTireur.Caption = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
ActiveSheet.[f2] = "TAPER ICI LES PREMIERES LETTRES DU NOM"
Exit Sub
End If
'
If Me.LblTireur.Caption <> "" Then Afficher i, Worksheets("Résultats")
End Sub
Private Sub TxtParticipants_Change()
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtParticipants.Text
iFlag = Range("B" & Rows.Count).End(xlUp).Row
iFlag1 = Worksheets("Tireurs").Range("A" & Rows.Count).End(xlUp).Row
'
iTestENTER = 0
'
If Me.TxtParticipants.Text = "" Then
Me.LblTireur.Caption = ""
Exit Sub
End If
'
If Asc(Right$(sFlag, 1)) = 43 Then
' Si TextParticipants est vide
If Len(sFlag) = 1 Then
Me.TxtParticipants.Text = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 0
Exit Sub
End If
iTestENTER = 1
sFlag = Left$(sFlag, Len(sFlag) - 1)
End If
'
Dim i As Integer 'Pensez à déclarer toutes tes variables
For i = 1 To iFlag1
If LCase$(sFlag) = LCase$(Left$(Worksheets("Tireurs").Range("C" & i).Value, Len(sFlag))) Then
If iTestENTER = 0 Then
sFlag = Worksheets("Tireurs").Range("A" & i).Value
Me.LblTireur.Caption = sFlag
Else
Afficher i, Worksheets("Résultats")
End If
Exit For
Else
Me.LblTireur.Caption = ""
End If
Next
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("c5:c120")) Is Nothing Then
ActiveCell.Offset(1, 0).Range("A1").Select
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").[g2] = "NOM SUIVANT ?"
Worksheets("Résultats").Range("c5:c120").Interior.ColorIndex = 0
End If
End SubC'est avec ces codes que j'obtiens les messages d'erreur rapportés dans mon précédent post.
A+, merci
Salut Mimouch,
je vais regarder ça dès maintenant!
A+
Tiens, un truc...
Une USF unique pour tout le traitement : encodage, points,...
Sinon, comme ceci, bien sûr!
A+
bonsoir,
oui tu n'as pas fini de modifier ton code ...
dans ta fonction affiche il faut remplacer TOUS tes Worksheets("resultats"). par sh. ! ...
ensuite lorsque tu appelle ta fonction :
Affiche i, Worksheet("resultats") le premier paramètre : i doit contenir le numéro de ligne à traiter ! si tu fait :
Dim i as integer
Affiche i, Worksheet("resultats") i = 0 et tu as donc plus loin une erreur 1004 car il n'existe pas de ligne 0 dans ta feuille ...!
si tu as un message "Variable non déclaré" ... et bien c'est que tu as oublié de déclarer une variable ... TOUTES les variables doivent être déclarée une et une seule fois ..
la plus part du temps cela ce passe en début de procédure
Private Sub TxtParticipants_Change()
'déclaration des variables ici : -----------------
dim sFlag as string ' déclaration d'une variable locale sFlag ( accessible seulement dans la procédure txtParticipants_Change()
'-------------------------
Worksheets("Résultats").[f2] = ""
Worksheets("Résultats").Range("k2:m2").Interior.ColorIndex = 6
'
sFlag = Me.TxtParticipants.TextBonsoir,
Je crois que j'ai (un peu) avancé, mais c'est super-dur pour moi...
Maintenant, j'ai un message d'erreur :
Erreur de compilation: Membre de méthode ou de données introuvable
sur la portion de code:
sh.[J1] = ""
sh.LblTireur.Caption = ""
sh.TxtParticipants.Text = ""
sh.Range("k2:m2").Interior.ColorIndex = 0de la macro "Afficher".
Ci-dessous le lien vers le fichier en son état actuel :
https://www.cjoint.com/c/FDnvPpw63vT
Merci pour votre aide,
Mimouch
Bonsoir Mimouch,
pas eu le temps cet après-midi, désolé!
Voici de nouveau ton fichier (enfin, ma version remaniée - je m'y retrouvais mieux!
J'ai supprimé le bouton GO/OUT ainsi que la possibilité de choisir la ligne d'affichage ainsi que tu l'avais fait dans l'évolution de ton travail.
A+
OUIIIIII !
Ca y est, je l'ai ! J'ai bien sûr un peu adapté à ma sauce, et cette fois ça fonctionne parfaitement...
Merci à tous pour votre patience.
(à la prochaine)