Impression par mot de passe

Question

Coucou la communauté ^^

Je cherche a faire une macri avec private sub pour que :

Quand j'inscrit le mot 'créance' dans la cellule H13 de ma feuille. Si j'appuie sur entrée ça m'imprime la zone active en 3 exemplaires puis embraye sur une macro que j'ai programmée.

Sauf que le private sub que j'ai fais foire.

A mon avis vous pouvez me débloquer sans mon code mais je vous le met au cas ou.

Donc ça foire ou? je dois écrire quoi pour changer tout ça?

Merciiii

Private Sub maj()
  If Range(H13) <> "créance" Then Exit Sub
  Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$V$359:$AF$416"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = False
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=3, Collate _
        :=True, IgnorePrintAreas:=False
    End If
    'macro qui est faite à la suite de Maj de mon sujet
    ActiveSheet.Unprotect
    Rows("21:21").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 15
    Range("D6").Select
    Selection.Copy
    Range("D21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("D8").Select
    Selection.Copy
    Range("E21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("H6").Select
    Selection.Copy
    Range("F21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("K21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C21:K350").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("C21"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("C21:K350")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D6").Select
    Selection.ClearContents
    Range("D8").Select
    Selection.ClearContents
    Range("D11").Select
    Selection.ClearContents
    Range("H6").Select
    Selection.ClearContents
    Range("H8").Select
    Selection.ClearContents
    Range("H11").Select
    Selection.ClearContents
    Range("H13").Select
    Selection.ClearContents
    Range("D12").Select
    Selection.ClearContents
    Range("H8").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("D6").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Banzai64 · Accepted Answer

Si tu veux que ta macro se déclenche lorsque tu modifies la cellule H13 il faut employer une macro évènementielle Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("H13"), Target) Is Nothing And Target.Count = 1 Then If Target &lt;&gt; "créance" Then Exit Sub '. '. '. End If End Sub...