Bonjour,
Voilà j'aimerais savoir si je peux enregistrer et archiver directement en PDF au lieu de xlsm.
Je vous joins mon code VBA que je n'ose pas toucher car déjà eu quelques soucis avec quand je m'en sers pour différents clients, il arrive souvent que je doive désinstaller excel et le réinstaller car lors de l'archivage j'ai une erreur 1004 qui me dit "workldentity" de l'objet "_workbook" a éhoué.
Du coup comme en ce moment ça ne le fait pas je n'ose rien toucher et surtout je ne connais pas la formule pour le faire.
J'ai un autre petit soucis avec ce fichier lorsque j'archive une fois mon devis ou facture faits le numéro incrémenté apparait sur le devis ou facture qui s'est enregistré, je suis obligée de l'effacer manuellement.
Merci de bien vouloir m'aider, car ça me sert pour plusieurs clients et j'en ai vraiment besoin.
Je précise que je suis sur MAC et que ma version d'excel est 16.19
Voici le code :
Sub Archivage_Devis() Dim chemin$, Sep$, nom$, chm$, Lks, B chemin = ThisWorkbook.Path PathSep = Application.PathSeparator nom = [D8] & "-" & Year([F4]) & "-" & Format([F4], "mmm") & "-" & Format([K5], "0000") & ".xlsx" '---------------------Création du fichier temporaire If [K5] = "" Then MsgBox "Veuillez saisir en cellule K5 le numéro du devis", , "Création abandonnée !": Exit Sub If MsgBox(" Si le devis est entièrement édité, veuillez confirmer" & vbCrLf & vbCrLf & _ " l'archivage du devis n° " & nom, vbYesNo, " Veuillez confirmer pour poursuivre,") = vbYes Then Application.EnableEvents = False Application.DisplayAlerts = False '-------Annulation des alertes '---------------------Nom du fichier à créer extension xlsx Sheets("Devis").Copy For Each B In ActiveSheet.Buttons B.Delete Next ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value Lks = ActiveWorkbook.LinkSources() If Not IsEmpty(Lks) Then For i = 1 To UBound(Lks): ActiveWorkbook.BreakLink Name:=Lks(i), Type:=xlExcelLinks: Next End If chm = chemin & PathSep & "Archives Devis" & PathSep & nom ActiveWorkbook.SaveAs chm, FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close '---------------------Après l'archivage le fichier se réinitialise Sheets("Devis").Range("F4,F5,A13:F17,A19:E22,F27").ClearContents Sheets("Devis").Range("K5").Value = Sheets("Devis").Range("K5").Value + 1 Application.DisplayAlerts = True '-------rétablissement des alertes Application.EnableEvents = True End If Application.Goto [K5] ActiveWorkbook.Save End Sub Sub Archivage_Factures() Dim chemin$, Sep$, nom$, chm$, Lks, B chemin = ThisWorkbook.Path PathSep = Application.PathSeparator nom = [D8] & "-" & Year([F4]) & "-" & Format([F4], "mmm") & "-" & Format([K5], "0000") & ".xlsx" '---------------------Création du fichier temporaire If [K5] = "" Then MsgBox "Veuillez saisir en cellule K5 le numéro de la facture", , "Création abandonnée !": Exit Sub If MsgBox(" Si la facture est entièrement éditée, veuillez confirmer" & vbCrLf & vbCrLf & _ " l'archivage de la facture n° " & nom, vbYesNo, " Veuillez confirmer pour poursuivre,") = vbYes Then Application.EnableEvents = False Application.DisplayAlerts = False '-------Annulation des alertes '---------------------Nom du fichier à créer extension xls Sheets("Facture").Copy For Each B In ActiveSheet.Buttons B.Delete Next ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value Lks = ActiveWorkbook.LinkSources() If Not IsEmpty(Lks) Then For i = 1 To UBound(Lks): ActiveWorkbook.BreakLink Name:=Lks(i), Type:=xlExcelLinks: Next End If chm = chemin & PathSep & "Archives Factures" & PathSep & nom ActiveWorkbook.SaveAs chm, FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close '---------------------Après l'archivage le fichier se réinitialise Sheets("Facture").Range("F4,F5,A14:F23,F25:F27,A36:F36,A38:F38").ClearContents Sheets("Facture").Range("K5").Value = Sheets("Facture").Range("K5").Value + 1 Application.DisplayAlerts = True '-------rétablissement des alertes Application.EnableEvents = True End If Application.Goto [K5] ActiveWorkbook.Save End SubMerci d'avance