Bonjour,
Voilà j'aimerais savoir si je peux enregistrer et archiver directement en PDF au lieu de xlsm.
Je sais qu'il y a une formule pour faire cela mais vu la complexité de mon VBA je ne sais pas où je dois l'incorporer.
Je vous joins mon fichier avec son 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 qui s'incrémente en K5 sur le fichier original apparait sur la copie du devis ou facture que j'ai archivé et enregistré, je suis obligée de l'effacer manuellement pour pouvoir l'enregistrer ensuite en pdf pour l'envoyer à mes clients.
Merci de bien vouloir m'aider, car ça me sert pour plusieurs clients et j'en ai vraiment besoin.
Je vous joins le code si vous avez besoin du fichier je le joindrais mais vu qu'il y a une macro, tout le monde ne l'ouvre pas forcément
Je précise que je suis sur MAC et que ma version d'excel est 16.19
voici le code VBA actuel :
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 Sub
Merci d'avance
Voilà j'aimerais savoir si je peux enregistrer et archiver directement en PDF au lieu de xlsm.
Je sais qu'il y a une formule pour faire cela mais vu la complexité de mon VBA je ne sais pas où je dois l'incorporer.
Je vous joins mon fichier avec son 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 qui s'incrémente en K5 sur le fichier original apparait sur la copie du devis ou facture que j'ai archivé et enregistré, je suis obligée de l'effacer manuellement pour pouvoir l'enregistrer ensuite en pdf pour l'envoyer à mes clients.
Merci de bien vouloir m'aider, car ça me sert pour plusieurs clients et j'en ai vraiment besoin.
Je vous joins le code si vous avez besoin du fichier je le joindrais mais vu qu'il y a une macro, tout le monde ne l'ouvre pas forcément
Je précise que je suis sur MAC et que ma version d'excel est 16.19
voici le code VBA actuel :
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 Sub
Merci d'avance