aide sur code vba (recherche onglet)

almas

XLDnaute Occasionnel
Bonjour a tous

Voila j 'ai trouvé et transposé un code que j 'ai trouvé sur le forum

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$3" Then Exit Sub
Application.EnableEvents = False
tx = [D3]
lig = 8
[C8:H200].ClearContents
For k = 1 To Sheets.Count
If Left(Sheets(k).Name, 1) = "T" Then
With Sheets(k).[A3:A27]
Set c = .Find(tx, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Cells(lig, 3) = Sheets(k).Name
Cells(lig, 4) = Sheets(k).Cells(c.Row, 2)
Cells(lig, 5) = Sheets(k).Cells(c.Row, 3)
lig = lig + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If
Next
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Mais je voudrai que la recherche se fasse non pas sur , un chiffre +1 et une lettre , mais par rapport a une liste "noms" qui contient les noms d' onglet

et je sais pas modifier cette partit du code

ci joint petit fichier test (edit: je viens de m 'apercevoir que j 'ai pas changer la lettre dans la lettre dans la liste des onglets de "S"a "T")
 

Pièces jointes

  • test recherche onglet.xls
    52 KB · Affichages: 42
Dernière édition:

CHALET53

XLDnaute Barbatruc
Re : aide sur code vba (recherche onglet)

Bonjour,

Essaie ceci : attention le nom de l'onglet alain comporte un blanc à la fin (plantage)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$3" Then Exit Sub
Application.EnableEvents = False
tx = [D3]
lig = 8
[C8:H200].ClearContents
'Stop
Set plage = Sheets("base").Range("B6:B12")
For Each cel In plage
k = cel.Value


With Sheets(k).[A3:A27]
Set c = .Find(tx, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Cells(lig, 3) = Sheets(k).Name
Cells(lig, 4) = Sheets(k).Cells(c.Row, 2)
Cells(lig, 5) = Sheets(k).Cells(c.Row, 3)
lig = lig + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'End If
Next
Application.EnableEvents = True
End Sub
 
Dernière édition:

almas

XLDnaute Occasionnel
Re : aide sur code vba (recherche onglet)

super ca marche ......merci beaucoup Chalet53 ca va bien m aider

par contre pourquoi le "stop" ?

et donc si je suis bien t 'a manipulation si le noms de l'onglet ce trouve dans la liste ça marche
mais si:
la plage de la liste est plus longue(donc prend des blancs)
ou
qu' il y a un nom dedans sans qu il y ai d' onglet qui le porte
ca plante c 'est bien ca?
donc à chaque rajout d'onglet il faut modifier la macro pour modifier la plage de sélection....ne pourrait on pas faire référence a un nom définit? plutôt qu 'a une plage de cellules

sinon je peut toujours créé 100 onglets en les numérotant et j 'aurai plus qu 'a renommer l' onglet que je souhaite utiliser vu que je modifiai d'office ma base de donnée (liste)
 
Dernière édition:

CHALET53

XLDnaute Barbatruc
Re : aide sur code vba (recherche onglet)

Le stop est en commentaire il me semble (sinon le mettre en commentaire ou le supprimer)
Remarques judicieuses

Pour pallier (et rallonger la liste sans blancs intercalés dans la liste):

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$3" Then Exit Sub
Application.EnableEvents = False
tx = [D3]
lig = 8
[C8:H200].ClearContents
'Stop
flag = 0
Set plage = Sheets("base").Range("B6:B12")
For Each cel In plage
k = cel.Value
If k = "" Then Application.EnableEvents = True: Exit Sub
'Stop
For Each sh In ActiveWorkbook.Sheets
If sh.Name = k Then flag = 1: Exit For
Next sh
If flag = 0 Then MsgBox ("La feuille n'existe pas, Faire les modif nécessaires"): Application.EnableEvents = True: Exit Sub

With Sheets(k).[A3:A27]
Set c = .Find(tx, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Cells(lig, 3) = Sheets(k).Name
Cells(lig, 4) = Sheets(k).Cells(c.Row, 2)
Cells(lig, 5) = Sheets(k).Cells(c.Row, 3)
lig = lig + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'End If
Next
Application.EnableEvents = True
End Sub


Mettre sur la même ligne les deux dernières en gras
 
Dernière édition:

almas

XLDnaute Occasionnel
Re : aide sur code vba (recherche onglet)

Bonjour

dsl pour la réponse tardive mais manque de temps pour bien décortiquer ce code.
avec cette modif on peut donc allonger indéfiniment la plage référence et mettre n' importe quelle noms dedans même si l onglet n 'existe pas . C 'est donc géniale , merci .Par contre :
je ne comprend pas pourquoi je peut rajouter des onglets sans problème , mais si je fait la moindre modif d un existant ça plante....
je ne suis pas le calcule du code
de plus je ne suis pas non plus la ligne :
If flag = 0 Then MsgBox ("La feuille n'existe pas, Faire les modif nécessaires"): Application.EnableEvents = True: Exit Sub

dsl le code est encore un peut dur pour moi ^^

édit: autant pour moi . je viens de comprendre qu il compare la liste au noms d onglet et que si il trouvent pas ça plante
donc il peut avoir des blancs en bout de liste mais pas de noms inexistant.
 
Dernière édition:

CHALET53

XLDnaute Barbatruc
Re : aide sur code vba (recherche onglet)

Bonjour
je ne comprend pas pourquoi je peut rajouter des onglets sans problème , mais si je fait la moindre modif d un existant ça plante....
Reprends le code ci-dessous, j'ai intégré deux modifications

If flag = 0 Then MsgBox ("La feuille n'existe pas, Faire les modif nécessaires"): Application.EnableEvents = True: Exit Sub

Dans le programme, il y a deux boucles
La première (For each cel in plage) lit les noms de feuilles dans la plage B6:B100 de la feuille Base
Pour chaque feuille identifiée de cette plage, une deuxième boucle (For Each sh In ActiveWorkbook.Sheets)
Celle-ci lit les onglets du fichier et les compare à chaque nom lu dans la plage B6:B100.
Flag est un pointeur(une variable) : il prend la valeur 0 à chaque lecture d'un nom de feuille dans la plage B6:B100 (au début de la première boucle)
Si, dans la deuxième boucle, je trouve un onglet du même nom, je donne la valeur 1 à flag et je sors de la boucle puisque j'ai trouvé la feuille
A la sortie de la boucle, je teste la valeur de flag : si elle est restée à 0 c'est que je n'ai pas trouvé l'onglet correspondant et je sors avec le message

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$3" Then Exit Sub
Application.EnableEvents = False
tx = [D3]
lig = 8
[C8:H200].ClearContents
'Stop

Set plage = Sheets("base").Range("B6:B100")
For Each cel In plage

flag = 0
k = cel.Value
If k = "" Then Application.EnableEvents = True: Exit Sub
'Stop
For Each sh In ActiveWorkbook.Sheets

If sh.Name = k Then a = sh.Name: flag = 1: Exit For
Next sh
If flag = 0 Then MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): Application.EnableEvents = True: Exit Sub
With Sheets(k).[A3:A27]
Set c = .Find(tx, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Cells(lig, 3) = Sheets(k).Name
Cells(lig, 4) = Sheets(k).Cells(c.Row, 2)
Cells(lig, 5) = Sheets(k).Cells(c.Row, 3)
lig = lig + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'End If
Next
Application.EnableEvents = True
End Sub


Attention à l'instruction : Application.EnableEvents = False
En cas de plantage avant la fin du programme qui remet la valeur à True , la procédure événementielle ne fonctionne plus

Il faut la réactiver avec un petit programme du style :

Sub evenmt()
Application.EnableEvents = True
End Sub
 
Dernière édition:

almas

XLDnaute Occasionnel
Re : aide sur code vba (recherche onglet)

ok merci beaucoup pour toutes ces explications CHALET53!!

j 'ai pu transposer ce code dans mon classeur sans problème;)

Par contre j 'ai jamais pu sortir ton message??? soit débugage soit ça marche ^^
 

almas

XLDnaute Occasionnel
Re : aide sur code vba (recherche onglet)

voila! parfait la j 'ai bien le message si l' onglet n 'existe pas !

Bravo Chalet53!:)

adapté dans mon fichier et fonctionne parfaitement !

Ce petit code peut être utilisé dans plein de situation merci ^^
 

Discussions similaires

Statistiques des forums

Discussions
312 393
Messages
2 088 014
Membres
103 699
dernier inscrit
samSam31