XL 2019 mettre 2 worksheet différents sur la même feuille

D

Dravol

XLDnaute Junior
Bonjour à tous,

Sauriez-vous comment je peux intégrer 2 worksheet dans une même feuille ?

1ière macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, Z$, plage
If Target.Count = 1 Then
Z = Target.Value
plage = "h18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "j18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q24:Q43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R24:R43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S24:S43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q45:Q48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R45:R48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S45:S48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If

End If
End Sub

2ième macro
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo line

If Target.Address = Range("d19").Address And Range("d19").Value > 10 Then

Dim I
For I = 1 To 3 ' Loop 3 times.
PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I

End If

line:
Exit Sub
End Sub

Je bute depuis plusieurs heures même en allant sur les forums (sachant que je suis pas expert dans les macros)

Merci d'avance pour votre aide^^
 
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour Dravol,

Plusieurs heures ??? Alors qu'il suffit d'insérer la 2ème macro (sans titre et End Sub) à la suite de la 1ère macro et avant le End Sub.

Simplement pour le 2ème code il faut que la fonction PlaySound soit reconnue...

A+
 
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
Bonjour job75

sans titre veut dire que je mets pas :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo line

Car je croyais qu'on ne pouvait pas mettre 2 private sub dans une même macro ?

Pour le Playsound quand je teste cette macro sur une feuille vierge elle fonctionne, par contre elle ne fonctionne pas lorsque je la mets à la suite de la 1ere macro.
 
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
Bonjour job75

As-tu la possibilité de mettre directement l'association des 2 macros dans ta réponse afin que vois ce qu'il faut faire ?
Pour playsound elle fonctionnait très bien toute seule à partir du moment ou je mettais le son dans le même dossier. J'ai essayé de mettre l'adresse en remplacement mais cela ne fonctionne pas.

ci-dessous mes modifs :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, Z$, plage
If Target.Count = 1 Then
Z = Target.Value
plage = "h18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "j18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q24:Q43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R24:R43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S24:S43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q45:Q48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R45:R48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S45:S48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
End If

If Target.Address = Range("a1").Address And Range("a1").Value > 10 Then

Dim I
For I = 1 To 3 ' Loop 3 times.
PlaySound "W:\EUFR\POUZ\$DATA\GRP-OPERATIONNEL\FAB\0257.wav"
MsgBox "Attention valeur hors tolérance"
Next I

End If

line:
Exit Sub
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Dravol,

Vous avez fait l'association des 2 codes vous-même.

Simplement pour le 2ème vous utilisez A1 alors qu'au post #1 c'était D198.

Si la fonction PlaySound ne fonctionne pas c'est votre affaire mais franchement elle est inutile.

Remplacez-la par Beep, c'est plus simple.

A+
 
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
job75

J'ai fais l'association des 2 codes mais ils ne fonctionnent pas ensemble ... c'est l'objet de ma demande initiale.

Pour Playsound je n'attends pas une réponse pour me dire qu'il sert à rien et de le remplacer par le beep de l'ordi (chose que j'ai fais et qui marche).
Si je demande cela c'est que j'en ai besoin (il s'agit d'une alerte bien plus "percutante" que le beep).

En clair, les 2 macros fonctionnent très bien séparément mais pas ensemble, par conséquent il doit y avoir un manque ou des erreurs au niveau du codage.

Merci Job75 pour le temps passé à me répondre.

J'envoie le lien du fichier pour celle/celui qui pourra m'aider .
En gros il faut ajouter la macro ci-dessous au fichier en pièce jointe :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo line

If Target.Address = Range("d19").Address And Range("d19").Value > 10 Then

Dim I
For I = 1 To 3 ' Loop 3 times.
PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
 

Pièces jointes

  • 20-02016 - FI0000.xls
    401.5 KB · Affichages: 10
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bah la cellule D19 est fusionnée avec E19, Target.Count vaut 2.

Il faut donc sortir le 2ème code du bloc If Target.Count = 1 Then/End If.

Et remplacer :
VB: 
If Target.Address = Range("d19").Address And Range("d19").Value > 10 Then
par :
Code: 
If Target.Address = Range("d19").MergeArea.Address And Range("d19").Value > 10 Then
 

Pièces jointes

  • 20-02016 - FI0000.xls
    418 KB · Affichages: 7
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
Bonjour job75

Merci pour ton aide ^^
Il y a juste un problème.
Le "beep + le message d'erreur" se déclenchent lorsqu'on clique sur la cellule et pas après la saisie.
L'idéal serait de faire déclencher la macro (beep + message d'erreur) juste après la saisie et lorsqu'on fait "enter" ou lorsqu'on clique dans une autre cellule.
 
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
job75 à dit:
Bonjour Dravol,

Normal puisqu'il s'agit d'une Worksheet_SelectionChange.

C'est vous qui l'avez voulu non ?

Le problème posé au post #1 étant résolu tout autre problème nécessite une nouvelle discussion.

A+
Cliquez pour agrandir...

Bonjour job75

On va pas arriver à se comprendre...
Je n'ai pas voulu Worksheet_SelectionChange dans la 2ieme macro (relire entièrement mon 1er message)

La deuxième macro fonctionne très bien toute seule (elle mets le message une fois la saisie effectuée)
Avec votre solution, la 2ieme macro se lance bien (merci encore pour cette 1iere étape d'ailleurs) mais quand on clique sur la cellule.

Je réitère donc ma demande, comment associer les 2 macros en gardant les mêmes fonctionnalités ?

Donc le poste est partiellement résolu puisqu'il réponds à l'association des 2 macros mais il change la fonctionnalité de la 2ième.

A+
 
Vote positif 0 Vote négatif
D

Dravol

XLDnaute Junior
Bon on arrête là...
Je vois qu'on arrive pas à se comprendre.
Votre : "à quoi vous jouez" est de trop.

Merci du temps passé à me répondre.

Je vais créer un autre post sur ce sujet.

(je ne vois pas pourquoi vous remettez sur le tapis le "Playsound" 4 post plus tard) !

C'est le risque quand l'on mets plusieurs sujets sur un même post, désolé.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
228
fanch55
fanch55
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
109
sebastien176
S
N
  • Question
Microsoft 365 Imbrication de deux formule Worksheet_BeforeDoubleClick
Réponses
1
Affichages
149
Nathan027
N
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
136
BenExcel
B
U
  • Question
Autres [RESOLU] Déclaration de variable
Réponses
5
Affichages
203
un internaute
U
N
  • Résolu(e)
Microsoft 365 Ajouter une condition dans une VBA
Réponses
2
Affichages
199
Nathan027
N
D
  • Question
Microsoft 365 Application.WorksheetFunction.VLookup ne fonctionne pas au delà de 8500 lignes
Réponses
4
Affichages
297
DimiJuju
D
S
  • Question
Microsoft 365 Clavier virtuel: SelectionChange, empêche la répétition
Réponses
3
Affichages
138
Simon 1234
S
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
225
chaelie2015
chaelie2015
P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
322
pat66
P

Membres actuellement en ligne

18 membres et 386 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 198
Messages
2 086 133
Membres
103 128
dernier inscrit
pmordel@parisbrestconsult