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