• Initiateur de la discussion Initiateur de la discussion tdenis
  • 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 !

tdenis

XLDnaute Nouveau
Bonjour le forum,
J'ai un petit soucis de code ci-dessous....
la deuxième partie du code avec le target ne fonctionne pas
Je vous remercie pour votre aide
Belle journée
Tdenis
VB:
Private Sub Devis_Accepte()
Dim Target As Range
Dim FeuillePrecedente As String
FeuillePrecedente = ActiveSheet.Name
Dim Ref_Val, Cellule_en_Cours As Range 'définition des variables, un variant, un range
    On Error GoTo Gere_Erreurs 'si erreur va à Gere_Erreurs
    With ActiveSheet.Tab
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        End With
        Sheets("Recap Dev.Fac").Select
                  Rows("2").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.EnableEvents = True
    Range(Cells(2, 1), Cells(2, 6)).Interior.ColorIndex = 34
    Range("A2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("K1").Value
    Range("B2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("B16").Value
    Range("C2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("F4").Value
    Range("D2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("F5").Value
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("F9").Value
    Selection.NumberFormat = "0#"".""##"".""##"".""##"".""##"
    Range("F2").Select
    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("F10").Value
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
            Rows("2").Select
               lrow = Selection.Row()
        Rows(lrow).Select
        Selection.Copy
        Rows(lrow + 1).Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        Selection.ClearContents
        Range(Cells(3, 1), Cells(3, 6)).Interior.ColorIndex = 0
    Sheets(FeuillePrecedente).Select
    If Not Intersect(Target, Range(Cells(16, 3), Cells(45, 4))) Is Nothing Then
        Application.EnableEvents = False
        For Each Cellule_en_Cours In Target(Range(Cells(16, 3), Cells(45, 4))) 'pour chaque cellule de l'intersection
            With Cellule_en_Cours 'avec la cellule en cours
                Select Case .Value 'selon la valeur de la cellule en cours
                Case Is = "Materiaux" 'exécute le code jusqu'au prochaine case si cellule en cours = valeur puis va à end select
                  Sheets("Recap Dev.Fac").Select
                    Rows("3").Select
                    Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
                    Application.EnableEvents = True
                    Range("A3").Select
                    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("D17").Value
                    Range("D3").Select
                    ActiveCell.Formula2R1C1 = Sheets(FeuillePrecedente).Range("H17").Value

                 End Select
            End With
        Next Cellule_en_Cours
        End If
    
Sheets(FeuillePrecedente).Select
On Error GoTo 0
Gere_Erreurs:
    Application.EnableEvents = True
    
End Sub
 
Solution
Bonjour thierry, le fil,

ton fichier en retour ; j'ai fait plein d'modifs, alors regarde partout ! il y aura sans doute des choses qui ne marcheront pas, mais c'est car ton projet est assez complexe, et c'que tu veux faire au juste n'est pas toujours très clair ; c'est pourquoi je ne pense pas pouvoir faire mieux ; malgré ça, je crois que tu apprécieras le gros travail que j'ai fait ; à te lire pour avoir ton avis. 😉

soan
Bonjour tdenis, CISCO,

en principe, on utilise Target ou Intersect(Target, ...) uniquement dans des procédures événementielles ; or ta sub Devis_Accepte() n'en n'est pas une ! 😕

exemple d'une procédure événementielle :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  '...
End Sub

note que Target apparaît dans l'en-tête de la sub, en tant qu'argument.

soan
 
Bonjour @tdenis, @CISCO, le forum

1)C'est intellectuellement bizarre cela :
VB:
FeuillePrecedente = ActiveSheet.Name
mais passons... car si elle est active elle est plus précédente voir Raymond Devos avec "le rond point"

2)Avec un fichier anonyme c'est bien plus facile....

3)Un nettoyage de code s'impose....
Un select case avec un seul case c'est luxueux....

Pour ton target voir la remarque de @soan et nous revenons au point 2) qui permettra de comprendre ce que tu veux faire.....

@Phil69970
 
@thierry (salut Phil)

j'ai bien vu ton post #5, mais je t'ai répondu ponctuellement à propos du Target ; et je te suggère de l'enlever, effectivement ; pour le reste, j'avoue que je n'ai pas trop envie de répondre sans un fichier ; de plus, y'a des choses qui marchent sur Excel version PC et pas sur Excel version MacIntosh.

je dois m'absenter, donc je vais arrêter mon PC ; j'espère que Phil ou un autre intervenant pourront t'aider davantage ; bonne chance ! 🍀​

soan
 
Bonjour thierry, le fil,

ton fichier en retour ; j'ai fait plein d'modifs, alors regarde partout ! il y aura sans doute des choses qui ne marcheront pas, mais c'est car ton projet est assez complexe, et c'que tu veux faire au juste n'est pas toujours très clair ; c'est pourquoi je ne pense pas pouvoir faire mieux ; malgré ça, je crois que tu apprécieras le gros travail que j'ai fait ; à te lire pour avoir ton avis. 😉

soan
 

Pièces jointes

- 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

Réponses
18
Affichages
210
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
229
Réponses
4
Affichages
355
Réponses
2
Affichages
392
Réponses
2
Affichages
421
Retour