Sauvegarde fichier en Excel et non plus en pdf
Bonjour,
J'ai actuellement un macro qui me permet de sauvegarder le fichier excel au format pdf dans un chemin spécifique selon la société.
J'aurai besoin de transformer la macro pour qu'elle fasse la même chose mais qu'elle sauvegarde au format excel afin d'avoir la main sur le fichier plus tard.
Pourriez-vous m'aider ?
Je ne comprends pas bien comment modifier le bout de code suivant :
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Code complet + je joins le fichier en copie.
Sub Sauvegarde()
Dim MyName As Range
Dim LName As String
Dim MySociete As Range
Set MyName = Range("C3")
Set MySociete = Range("J2")
LName = Left(MyName, 1)
If MySociete.Value = "RENAULT TRUCKS SAS" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
If MySociete.Value = "Renault Trucks Defense" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
End Sub
Merci d'avance pour votre aide.
Cédric
Bonjour pitochico,
voici le code adapté:
Sub SauvegardeXL()
Dim MyName As String, LName As String, MySociete As String, MonFichier As String
Dim wb As Workbook
MyName = Range("C3")
MySociete = Range("J2")
LName = Left(MyName, 1)
If MySociete = "RENAULT TRUCKS SAS" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"
MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Path & MonFichier
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
If MySociete = "Renault Trucks Defense" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"
MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Path & MonFichier
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
End Sub
Cordialement
Merci Sequoyah,
Cela correspond en partie à mon besoin, cependant la macro ne sauvegarde que l'onglet "décomposition", hors j'aurai besoin de sauvegarder l'ensemble du fichier Excel pour pouvoir le réutiliser plus tard au besoin.
A savoir les onglets :
décomposition
avenant TP thérapeut
Possible de m'aider sur ce point ?
Merci d'avance.
Cédric
Bonjour Cédric:
voici le nouveau code:
Sub SauvegardeXL2()
Dim MyName As String, LName As String, MySociete As String, MonFichier As String
Dim wb As Workbook
MyName = Range("C3")
MySociete = Range("J2")
LName = Left(MyName, 1)
If MySociete = "RENAULT TRUCKS SAS" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"
MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & MyName & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"
Sheets(Array("Décomposition", "Avenant TP thérapeut")).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Path & MonFichier
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
If MySociete = "Renault Trucks Defense" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"
MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & MyName & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"
Sheets(Array("Décomposition", "Avenant TP thérapeut")).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Path & MonFichier
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Déplacer le document dans le dossier du salarié"
Call Shell("explorer.exe " & Path, vbNormalFocus)
End If
End Sub
Super encore fois, correspond parfaitement à mon besoin maintenant
un grand merci de toute l'équipe RH pour ton aide