Faire cohabiter deux Vba

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

  • Deux VBA.xls
    37 KB · Affichages: 59
Trier par date Trier par votes
Pierrot93

Pierrot93

XLDnaute Barbatruc
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
Pierrot93

Pierrot93

XLDnaute Barbatruc
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
A

Arcangeli

XLDnaute Occasionnel
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
A

Arcangeli

XLDnaute Occasionnel
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

  • PROJET.xls
    29.5 KB · Affichages: 54
  • PROJET.xls
    29.5 KB · Affichages: 41
  • PROJET.xls
    29.5 KB · Affichages: 43
Vote positif 0 Vote négatif
A

Arcangeli

XLDnaute Occasionnel
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
A

Arcangeli

XLDnaute Occasionnel
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
Pierrot93

Pierrot93

XLDnaute Barbatruc
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
A

Arcangeli

XLDnaute Occasionnel
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

  • PROJET Bis.xls
    26.5 KB · Affichages: 49
  • PROJET Bis.xls
    26.5 KB · Affichages: 50
  • PROJET Bis.xls
    26.5 KB · Affichages: 47
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
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

Discussions similaires

B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
177
boguinette
B
B
  • Question
XL 2016 Affichage de la fenêtre "Propriétés" d'un fichier.
Réponses
1
Affichages
192
sylvanu
sylvanu
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
169
BenExcel
B
Milkabout
  • Question
XL 2016 Calendrier Scolaire / Congés
Réponses
3
Affichages
458
Milkabout
Milkabout
M
  • Question
XL 2010 croisements multiples & démultiplications
Réponses
9
Affichages
543
sylvanu
sylvanu
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
312
phoceenjo
P
M
  • Résolu(e)
Microsoft 365 Aide sur macro (débutant inside)
2
Réponses
16
Affichages
374
Phil69970
Phil69970
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
294
kiki29
kiki29
V
  • Question
Microsoft 365 Planning Hopital de jour
Réponses
1
Affichages
247
sylvanu
sylvanu
C
  • Question
XL 2016 Faire un tableau de nombres uniques puis associer des images aux cellules
Réponses
4
Affichages
270
DJunqueira
D

Membres actuellement en ligne

Aucun membre en ligne actuellement.
2 membres et 32 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 489
Messages
2 088 855
Membres
103 976
dernier inscrit
kaizertv2001@gmailcom