Clearcontents qui fonctionne en Pas à pas mais pas en auto

Sub save()
Dim nature%, x%, chemin$
Dim NArange As Range, GBLrange As Range, OKrange As Range, NOKrange As Range, NCrange As Range
Dim objLink As Hyperlink

Set NArange = Sheets("Audit").Range("F8:F" & Sheets("Audit").Range("A100").End(xlUp).Row)
Set GBLrange = Sheets("Audit").Range("D8:E" & Sheets("Audit").Range("A100").End(xlUp).Row)
Set OKrange = Sheets("Audit").Range("C8:C" & Sheets("Audit").Range("A100").End(xlUp).Row)
Set NOKrange = Sheets("Audit").Range("D8:D" & Sheets("Audit").Range("A100").End(xlUp).Row)
Set NCrange = Sheets("Audit").Range("E8:E" & Sheets("Audit").Range("A100").End(xlUp).Row)

nature = IIf(Sheets("Audit").Range("I4").Value = "LPA", 35, 40)

If Sheets("Audit").Range("I4").Value = "LPA" Then
chemin = "H:\TREMOIS\TREMOIS_Production_HAPP\LPA\Archives\" & Sheets("Audit").Range("A1").Value & " LPA.pdf"
Else
chemin = "H:\TREMOIS\TREMOIS_Qualité\8- Système\3- Audits\3- Audit de poste - Audits process\Audit de Poste\Enregistrement audits\" & Sheets("Audit").Range("A1").Value & " " & Sheets("Audit").Range("H2").Value & ".pdf"
End If

With Sheets("Récap audit")
    lin = .Range("A10000").End(xlUp).Row + 1
    .Cells(lin, 1).Value = Sheets("Audit").Range("I4").Value
    .Cells(lin, 2).Value = Sheets("Audit").Range("A1").Value
    Set objLink = .Hyperlinks.Add(.Cells(lin, 2), chemin)
    .Cells(lin, 3).Value = Date
    .Cells(lin, 4).Value = Sheets("Audit").Range("J2").Value
    .Cells(lin, 5).Value = Sheets("Audit").Range("J3").Value
    If Sheets("Audit").Range("G2").Value = "Accompagnateur" Then .Cells(lin, 6).Value = Sheets("Audit").Range("H2").Value
    .Cells(lin, 7).Value = Sheets("Audit").Range("C2").Value
    .Cells(lin, 8).Value = Sheets("Audit").Range("H2").Value
    .Cells(lin, 9).Value = Sheets("Audit").Range("C3").Value
    .Cells(lin, 10).Value = Sheets("Audit").Range("C4").Value
    .Cells(lin, 11).Value = nature - Application.WorksheetFunction.CountIf(NArange, "X")
    .Cells(lin, 12).Value = (.Cells(lin, 11).Value - Application.WorksheetFunction.CountIf(GBLrange, "X")) / .Cells(lin, 11).Value
    .Cells(lin, 13).Value = Application.WorksheetFunction.CountIf(OKrange, "X")
    .Cells(lin, 14).Value = Application.WorksheetFunction.CountIf(OKrange, "X") / .Cells(lin, 11).Value
    .Cells(lin, 15).Value = Application.WorksheetFunction.CountIf(NOKrange, "X")
    .Cells(lin, 16).Value = Application.WorksheetFunction.CountIf(NOKrange, "X") / .Cells(lin, 11).Value
    .Cells(lin, 17).Value = Application.WorksheetFunction.CountIf(NCrange, "X")
    .Cells(lin, 18).Value = Application.WorksheetFunction.CountIf(NCrange, "X") / .Cells(lin, 11).Value
    .Cells(lin, 19).Value = Application.WorksheetFunction.CountIf(NArange, "X")
    .Cells(lin, 20).Value = Application.WorksheetFunction.CountIf(NArange, "X") / .Cells(lin, 11).Value
    '.Cells(lin, 21).Value = action dans le plan d'action non cloturé
    'for NCcloture=NCcloture to
    .Cells(lin, 22).Value = Format(Date, "ww")
    .Cells(lin, 23).Value = Application.VLookup(Sheets("Audit").Range("J2").Value, Sheets("Liste choix").Range("D1:E" & Sheets("Liste choix").Range("D100").End(xlUp).Row), 2, False)
    For x = 24 To 32
        If .Cells(1, x).Value = .Cells(lin, 23).Value Then
            .Cells(lin, x).Value = 1
            Exit For
        End If
    Next x
    .Cells(lin, 28).Value = .Cells(lin, 15).Value + .Cells(lin, 17).Value
    If .Cells(lin, 21).Value = "" Then
        .Cells(lin, 29).Value = 1
    Else
        .Cells(lin, 29).Value = 1 - (.Cells(lin, 21).Value / .Cells(lin, 28).Value)
    End If
    .Cells(lin, 30).Value = 1
    If MsgBox("Suite à cet audit, y a t'il des PA?", vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then .Cells(lin, 31).Value = InputBox("Entrer le nombre de PA", "Nombre de PA")
    .Cells(lin, 32).Value = Format(Date, "YYYY")
    .Cells(lin, 33).Value = Sheets("Audit").Range("J49").Value
    .Cells(lin, 34).Value = Sheets("Audit").Range("K49").Value
End With

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=chemin _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

   Sheets("Audit").Range("C8:K47,C49:K62,C2:F3,C4:G4,H2,J2:K3,I4:K4").ClearContents
  Sheets("Audit").Range("G8:K16,G18:K19,G21:K23,G25:K26,G28:K30,G32:K34,G36:K37,G39:K39,G42:K42,G44:K47,G49:K49,G51:K51,G53:K53,G55:K55,G58:K62").Interior.ColorIndex = -4142
End Sub

Bonjour, j’exécute la macro et elle me met une erreur 1004 sur

Sheets("Audit").Range("C8:K47,C49:K62,C2:F3,C4:G4,H2,J2:K3,I4:K4").ClearContents

alors que quand je l'execute en pas à pas ça fonctionne ...

Si quelqu'un à une idée je suis preneur , merci à vous

Bonjour,

Remplace

.clearcontents

par

=""

Bonjour,

En plaçant votre clearcontents dans une autre macro que vous appelerez dans votre code.

Sub ClearRanges() 
 Worksheets("Audit").Range("C8:K47,C49:K62,C2:F3,C4:G4,H2,J2:K3,I4:K4"). _ 
 ClearContents

End Sub

Merci !

Ca ne fonctionne pas :/

(deuxième module)

9test-forum.xlsm (312.96 Ko)

Ce n'est ainsi que j'avais écris la macro.

Je suppose que dans le module c'est la Sub test

Sub test()
   Worksheets("Audit").Range("C8:K47,C49:K62,C2:F3,C4:G4,H2,J2:K3,I4:K4"). _
   ClearContents
  Worksheets("Audit").Range("G8:K16,G18:K19,G21:K23,G25:K26,G28:K30,G32:K34,G36:K37,G39:K39,G42:K42,G44:K47,G49:K49,G51:K51,G53:K53,G55:K55,G58:K62").Interior.ColorIndex = -4142
End Sub

Ainsi elle fonctionne de mon coté la sub test.

6test-forum-1.xlsm (288.58 Ko)

appuies sur le bouton "enregistrer" dans l'onglet Audit

Ton bouton enregistrer

-renvoi des Call sur d'autres macro

Dans la Call save tu appels la macro "Clear" et nom la macro "test" celle qui contient le "clearcontent"

Par ailleurs puisque tu lances tes call à partir du bouton dans ce cas inutile d'ajouter cette ligne à

à la fin de ton sub save.

Tu l'ajoutes à tes autres call ce sera plus clair.

Private Sub CommandButton1_Click()
If (Sheets("Audit").Range("J49").Value = "" Or Sheets("Audit").Range("k49").Value = "") And Sheets("Audit").Range("I4").Value = "LPA" Then
MsgBox "veuillez mettre un temps standard et un temps r?el"
Exit Sub
End If
Call roadmap
Call save
Call test

End Sub

Comme çà si cela bug tu verras tout de suite si c'est la sub test qui bug ou la sub save.

j'ai essayé comme ça et ca bug dans la macro test

j'ai essayé comme ça et ca bug dans la macro test

je vois pas là de mon coté je n'ai aucun mal avec la sub Test. tu as bien modifié comme je l'avais

écrite ?

Sub test()
   Worksheets("Audit").Range("C8:K47,C49:K62,C2:F3,C4:G4,H2,J2:K3,I4:K4"). _
   ClearContents
  Worksheets("Audit").Range("G8:K16,G18:K19,G21:K23,G25:K26,G28:K30,G32:K34,G36:K37,G39:K39,G42:K42,G44:K47,G49:K49,G51:K51,G53:K53,G55:K55,G58:K62").Interior.ColorIndex = -4142
End Sub

oui j'ai bien remplacé ...

quand je lance la macro ca ne fonctionne pas il me met un message d'erreur 1004.

je pense que c'est parce que je suis entrain de sauvegarder en pdf... je ne sais pas...

mais quand je lance la macro en auto ca fonctionne pas , si je marque un arret et ou que je lance pas à pas ca fonctionne

même si j'enlève l'impression pdf ca ne fonctionne pas ... erreur 1004

Rechercher des sujets similaires à "clearcontents qui fonctionne pas auto"