XL 2010 Date dans fichier pour impression pdf

Option Explicit

Import_Fichiers_P()

' On n'affiche pas les alertes

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveWorkbook.Save

' Déclaration des variables

Dim FSO As Object, Rep As String
Dim r As Object, F As Object, Fichier As String ' r : répertoire, F : Dossier
Dim FicImport As String, NomFic As String
Dim NbCol As Long, NbLigne As Long
Dim i As Integer, J As Integer
Dim l As Integer, c As Integer
Dim ligne As Integer, col As Integer
Dim FicPrincipal As String
Dim ImportPlat As String

' On commence par le nombre de colonnes et de lignes totales
NbCol = Application.Columns.Count
NbLigne = Application.Rows.Count

' On définie les colonnes et les lignes du fichier où on importe à 1
l = 1
c = 1


FicImport = "P " & Format(Date, "YYYYMMDD")
Workbooks.Add.SaveAs Filename:="C:\Users\Sauvegardes fichiers\" & FicImport
FicPrincipal = "Formulaire pilotage.xlsm"
ImportPlat = "C:\Users\Import P\"



NomFic = ActiveWorkbook.Name

Set FSO = CreateObject("Scripting.FileSystemObject")
Rep = "C:\Users\Documents\"
Fichier = "Formulaire saisie.xlsm"

'On créée une feuille dans notre fichier d'import
'Workbooks(NomFic).Sheets.Add(After:=Sheets(Sheets.Count)).Name = r.Name

'On désactive les macros
Application.EnableEvents = False

Workbooks.Open Filename:=Rep & Fichier

'On désactive les macros
Application.EnableEvents = True

'On se place dans le fichier source
With Workbooks(Fichier).Sheets("Base")
'On compte le nombre de lignes et de colonnes
ligne = .Cells(NbLigne, 1).End(xlUp).Row
col = .Cells(1, NbCol).End(xlToLeft).Column
l = 1
'On boucle sur les lignes
For i = 1 To ligne ' au lieu de 3 avec l'ancien tableau
'On remet la colonne du fichier où on importe à 1
c = 1
'On boucle sur les colonnes
For J = 1 To col
'On colle la cellule
Workbooks(NomFic).Sheets("Feuil1").Cells(l, c).Value = .Cells(i, J).Value
'On incrémente la colonne
c = c + 1
Next
'On incrémente la ligne
l = l + 1
Next

End With

'On ferme le fichier source
Workbooks(Fichier).Close


'On remet les alertes en place
Application.DisplayAlerts = True
Application.ScreenUpdating = True


With ActiveWorkbook
.Save
.Close
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Cliquez pour agrandir...

Sub ImpressionEtats()

Dim Path As String
Dim DateFichier As String
Dim MonFichier As String
Dim Restitution as string

Path = "\\Etatss\"
MonFichier = "Etat - " & Format(Date, "DD MM YYYY")
Restitution = "Restitution.xlsx"

Application.DisplayAlerts = False
'DateFichier = InputBox("Date du fichier PDF ? format JJ MM AAAA") 'saisir la date du fichier


Workbooks.Open Filename:=Restitution
Sheets("Base").Activate

' Save Worksheet as PDF
'ActiveSheet.ExportAsFixedFormat xlTypePDF, Path & "\" & MonFichier & " -" & DateFichier & ".pdf"
ActiveSheet.ExportAsFixedFormat xlTypePDF, Path & "\" & MonFichier & ".pdf"
ActiveWorkbook.Save
ActiveWorkbook.Close

end sub

Cliquez pour agrandir...