Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Faire cohabiter deux Vba

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Arcangeli
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

Arcangeli

XLDnaute Occasionnel
Bonjour le Forum.
Encore besoin de vous car j'aimerais fusionner 2 Vba (je s'ait pas si fusioner est le terme exact)
Plus d'explications en pièce jointe.
Déjà merci si une solution existe.
 

Pièces jointes

Trier par date Trier par votes
Re : Faire cohabiter deux Vba

Bonjour,

essaie ceci, non testé :
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Select Case Target.Value
Case ""
Case Else
For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[C:C], Target)
Case 0
Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If
Case Else
GoTo a_modifier
End Select
Next
End Select
Exit Sub
a_modifier:
myPrompt = " !!! Cette donnée existe déjà dans la feuille " & Sheets(i).Name & " Ligne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row & " colonne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Column
       
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Attention")
Target = myInput
End If
If Target.Address = "$H$7" Then
Rows(Target.Row).Insert
Application.EnableEvents = False
Sh.Unprotect
Sh.Range("B7").Value = "--"
Sh.Range("J7").FormulaLocal = "=F7*Tarif"
Sh.Range("I7").FormulaLocal = "=SI(J7< 55;55;F7*Tarif)"
Sh.Range("G7").FormulaLocal = "=SI(J7=0;0;I7)"
ActiveSheet.Protect , AllowInsertingRows:=True
Application.EnableEvents = True
Range("$a$7").Select
End If
End Sub

bon après midi
@+
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Merci Pierro93,
Malheureusement ça ressemble à ce que j'avais essayé, mais ça ne marche pas.
Si tu as encore envie d'essayer......... j'en serais reconnaissant
A plus si ok
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Re,

pas top tes protections, essaye comme suit :
Code: 
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
    ws.Protect userinterfaceonly:=True
Next ws
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Select Case Target.Value
Case ""
Case Else
For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[C:C], Target)
Case 0
Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If
Case Else
GoTo a_modifier
End Select
Next
End Select
Exit Sub
a_modifier:
myPrompt = " !!! Cette donnée existe déjà dans la feuille " & Sheets(i).Name & " Ligne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row & " colonne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Column
       
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Attention")
Target = myInput
End If
If Target.Address = "$H$7" Then
Rows(Target.Row).Insert
Sh.Range("B7").Value = "--"
Sh.Range("J7").FormulaLocal = "=F7*Tarif"
Sh.Range("I7").FormulaLocal = "=SI(J7< 55;55;F7*Tarif)"
Sh.Range("G7").FormulaLocal = "=SI(J7=0;0;I7)"
Range("$a$7").Select
End If
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Encore Merci Pierro 93.
C'est mieux, mais maintenant ça coince sur une autre ligne de la Vba.
Ce soir je vais reprendre le problème à Zero et revenir à toi si besoin, car il me semble que l'on est sur la bonne route.
A bientôt si je n'y arrive pas
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Merci Pierrot 93
J'ai encore essayé mais j'y perd mon latin (que je n'ai d'ailleurs jamais étudié)
J'ai mis en pièce jointe un exemple de l'application que j'aimerais modifier.
Si tu pense que c'est possible.
A plus si oui
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Oui Pierrot93 tu as raison, mais lorsque je l'utilise je perd la fonction d'ajout de ligne, c'est pour cette raison que je mis en pièce jointe l'application d'origine (simplifiée) à l'aquelle j'aimerais bien ajouter cette fonction d'empêcher les doublons sur la colonne "C"
Ce qui m'ennuye c'est que les deux Vba fonctionnent très bien séparément et que je n'arrive pas à les faire tourner ensemble.
C'est vraiment gentil de ta part de te pencher sur ce cas.
Par contre maintenant je dois quitter le bureau et qui sait, si demain matin j'aurais la surprise.
Encore merci
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Désolé de revenir sur le sujet, mais j'aimerais tellement pouvoir réunir ces deux codes sur une même application.
En fait, le premier code qui est sur l'exemple en pièce jointe me permets d'ajouter automatiquement un ligne au dessus de laquelle j'arrive au bout et repositionner le curseur en début de la ligne ajoutée. Tout ça fontionne très bien. mais en même temps, pouvoir signaler les éventuels doublons de la colonne "C" avec le deuxième code (que j'ai trouvé sur ce forum) et qui lui aussi fonctionne très bien tout seul.
J'ai une pièce jointe pour que vous puissiez essayer de la modifier.
Si ça marche je ne saurais pas comment vous remercier, mais vous aurez ma reconaissance éternelle.
Sincèrement
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Bonjour,

comme dit hier soir, la solution proposé dans le post #4 semble fonctionner chez moi..... vérifie que les procédures événementielles soient bien activées en placant un point d'arret, si ce n'est pas le cas exécute cette instruction dans un module standard :
Code: 
Application.EnableEvents = True

bon après midi
@+
 
Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Pierrot93, déjà merci de continuer à me répondre.
Malheureusement, soit je suis trop nul soit il y a incompatibilité avec mon PC.
En pièce jointe, j'ai mis ma petite appolication avec ton code posté en #4, mais comme tu pourra le constater je perds les deux fonctions.
Si tu as encore un peux de patiente merci de réparer la pièce jointe.
Sincères salutations
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Faire cohabiter deux Vba

Re,

aarf, autant pour moi, il y avait un "exit sub" de ce fait les procédures événementielle n'étaient pas réactivées... Réactive les au préalable avec l'instruction donnée tout à l'heure ou en fermant complètement Excel...

Code: 
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
    ws.Protect userinterfaceonly:=True
Next ws
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Select Case Target.Value
Case ""
Case Else
For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[C:C], Target)
Case 0
Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If
Case Else
GoTo a_modifier
End Select
Next
End Select
GoTo fin
a_modifier:
myPrompt = " !!! Cette donnée existe déjà dans la feuille " & Sheets(i).Name & " Ligne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row & " colonne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Column
       
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Attention")
Target = myInput
End If
If Target.Address = "$H$7" Then
Rows(Target.Row).Insert
Sh.Range("B7").Value = "--"
Sh.Range("J7").FormulaLocal = "=F7*Tarif"
Sh.Range("I7").FormulaLocal = "=SI(J7< 55;55;F7*Tarif)"
Sh.Range("G7").FormulaLocal = "=SI(J7=0;0;I7)"
Range("$a$7").Select
End If
fin:
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Commande filtre
2
Réponses
16
Affichages
505
litelsousa
F
  • Question Question
Autres problème de cache de TCD menant à des données partielles
2
Réponses
20
Affichages
684
chris
M
  • Résolu(e)
XL 2021 Récupérer la valeur d’une cellule dans un classeur fermé
Réponses
5
Affichages
352
patricktoulon
G
  • Question Question
Microsoft 365 publipostage : problème
Réponses
5
Affichages
623
Hecatonchire
H
C
  • Résolu(e)
XL 2019 Sélection en cascade ou Groupe
Réponses
12
Affichages
346
ciarab8442
C
  • Question Question
XL 2021 Besoin aide sur macro en VBA
Réponses
0
Affichages
264
Francoise_nord
A
  • Résolu(e)
XL 2019 Optimisation code VBA (Icônes flottantes)
Réponses
14
Affichages
713
Amilo
A
  • Résolu(e)
XL 2021 Tableau Classement Skull King
Réponses
6
Affichages
441
Cousinhub
A
  • Résolu(e)
Microsoft 365 Fusion de 2 tables
Réponses
6
Affichages
331
Amilo
A
N
  • Question Question
Microsoft 365 Propagation de formule dans un tableau avec des valeurs existantes (saisies manuellement)
Réponses
4
Affichages
400
NikonvsWild
N
  • Question Question
XL 2021 Mise à jour d'un tableau depuis une feuille Excel
Réponses
5
Affichages
405
thunder23
  • Question Question
XL 2021 Détecter un changement dans un des contrôles de formulaire et mettre à jour un TS correspondant.
2
Réponses
15
Affichages
707
jeff1494
C
  • Question Question
Microsoft 365 Liste déroulante dynamique / dépendante d'un critère ou plus, *sans* VBA ? Une sorte d'Unique à conditions ? + ordre alpha ?
Réponses
8
Affichages
414
JHA
J
A
  • Question Question
XL 2021 Recherche 2 codes en VBA si existe avec mise en couleur
Réponses
1
Affichages
239
job75
O
  • Question Question
XL 2019 Piocher dans une case pour en compléter une autres.
Réponses
7
Affichages
545
Oska51
O
  • Résolu(e)
XL 2021 Une aide pour optimiser du code VBA
2
Réponses
16
Affichages
705
jeff1494
  • Question Question
XL 2016 Renseigner un tableau a partir d'un autre selon un ordre précis des colonnes
Réponses
2
Affichages
246
KTM
  • Résolu(e)
Autres lancement de la phase de tests Publics du vba Indenter Beautifier avec nouveau moteur XML
Réponses
9
Affichages
528
fanch55
M
  • Question Question
XL 2016 pb création de tableau par macro
Réponses
10
Affichages
411
ChTi160
V
  • Question Question
Microsoft 365 VBA deux document Excel
Réponses
10
Affichages
778
vroumvroum
V
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…