XL 2010 Date dans fichier pour impression pdf

[Aldonanou]

Bonjour, j'ai réalisé un USF dans lequel je souhaiterais pouvoir lancer l'impression en pdf de la sélection en fonction d'une date figurant dans le fichier.

L'import des données de ce fichier s'effectue correctement, tout fonctionne mais

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

Mais je ne parviens pas à savoir comment récupérer la valeur

LA procédure pour imprimer en pdf

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

Je pense qu'il faudrait effectuer un filtre sur la date avec un inputbox et ensuite pouvoir générer le fichier.

Auriez-vous des idées pour mener à bien se projet.

Merci d'avance.

 

[kiki29]

Salut, à consulter si curieux : Liste Contributions PDF

il y a FileDateTime à adapter à ton contexte, qui renvoie la date et l’heure de création ou de dernière modification d’un fichier.

Option Explicit
Sub tst()
Dim sDate, sFichier As String
    sFichier = "C:\Faq\Faq_VBA\Exemples\PDF\Test Print.pdf"
    sDate = FileDateTime(sFichier)
    Debug.Print sDate
End Sub

sinon il y a :
DateCreated DateLastAccessed DateLastModified

 

[Aldonanou]

Bonjour kiki29,

J'ai trouvé, je ne mettais pas la date dans le bon format ... ces dates sous Excel !

Sub AppelDate()

' Déclaration des variables
Dim fVentesA As String
Dim CheminSave As String
Dim CheminCtrl As String
Dim Datefichier As String
Dim oFSO As Object
Dim Quad As String
Dim Annee As String
Dim DateExtraction As Date
Dim DateVente As Date
Dim MoisFichier As String
Dim AnneeFichier As String
Dim JourFichier As String
Dim xWS As Worksheet
Dim rng As Range

CheminSave = "S:\Sauvegardes fichiers\"
CheminCtrl = "S:\Contrôles\"

Datefichier = InputBox("Date en cours ? format AAAAMMJJ")
Quad = InputBox("Quel quadrimestre ? format Qx")


fVentesA = "Ventes " & Datefichier & ".xlsx"

DateVente = InputBox("Date à rechercher : format JJ/MM/AAAA")
MoisFichier = Mid(DateFab, 4, 2)
AnneeFichier = Right(DateFab, 4)
JourFichier = Left(DateFab, 2)

DateExtraction = MoisFichier & "/" & JourFichier & "/" & AnneeFichier

' Ouverture du fichier Ventes Accueil
Workbooks.Open Filename:=CheminCtrl & Quad & "\" & fVentesA
Sheets("R_CIVA_temporaire").Select

' Désactive
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If

' Sélection en fonction du quadrimetre des données de l'onglet Temporaire
'If DateExtraction = DateFab Then
With Worksheets("Temporaire")
With .Range("A1:Z" & Cells(.Rows.Count, "R").End(xlUp).Row)
[A1].AutoFilter Field:=1, _
Criteria1:="=" & Format(DateFab, "dd/mm/yyyy")
End With
End With
'End If

End Sub

Merci beaucoup pour votre aide.