VBA Impression au format PDF et de les Enregistrer avec Automatique de Nom de Fichier
J'ai un code qui imprime une zone sélectionnée dans une feuille de calcul pour PDF
et permet à l'utilisateur de sélectionner un dossier et un nom de fichier d'entrée.
Il y a deux choses que je veux faire:
- Est-il possible que le fichier PDF peut créer un dossier sur les utilisateurs de bureau et enregistrez le fichier avec un nom de fichier spécifique, basé sur des cellules dans la feuille?
- Si plusieurs copies de la même feuille sont enregistrés/imprimé au format PDF peut chaque copie d'un nombre par exemple. 2, 3 dans le nom de fichier basé sur le nombre de copies?**
Voici le code que j'ai pour l'instant:
Sub PrintRentalForm()
Dim filename As String
Worksheets("Rental").Activate
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("Rental").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
End If
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("RentalCalcs").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
End Sub`
Mise à JOUR:
J'ai changé le code et les références et maintenant cela fonctionne. J'ai lié le code d'un bouton de commande sur la Location de Feuille -
Private Sub CommandButton1_Click()
Dim filenamerental As String
Dim filenamerentalcalcs As String
Dim x As Integer
x = Range("C12").Value
Range("C12").Value = x + 1
Worksheets("Rental").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerental = Path & "\" & Sheets("Rental").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Rental").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerental, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("RentalCalcs").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerentalcalcs = Path & "\" & Sheets("RentalCalcs").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("RentalCalcs").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerentalcalcs, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("Rental").Activate
Range("D4:E4").Select
End Sub
OriginalL'auteur Preena | 2014-11-30
Vous devez vous connecter pour publier un commentaire.
J'espère que c'est auto-explicatif suffisant. Utilisez les commentaires dans le code pour vous aider à comprendre ce qui se passe. Passer d'une cellule unique à cette fonction. La valeur de cette cellule sera le nom de base du fichier. Si la cellule contient "AwesomeData" ensuite, nous allons essayer de créer un fichier dans le courant les utilisateurs de bureau appelé AwesomeData.pdf. Si cela existe déjà essayer AwesomeData2.pdf et ainsi de suite. Dans votre code, vous pouvez simplement remplacer les lignes
filename = Application.....
avecfilename = GetFileName(Range("A1"))
Les lignes de débogage pour vous aider à comprendre ce qui se passe si vous avez besoin de parcourir le code. Les supprimer comme bon vous semble. Je suis allé un peu fou avec les variables, mais c'était pour faire cela aussi clairement que possible.
En Action
Ma cellule O1 contenus de la chaîne "nom de fichier" sans les guillemets. Utilisé de cette sous à l'appel de ma fonction et de l'enregistrer dans un fichier.
Où est votre code situé en référence pour tout le reste? Peut-être vous avez besoin de faire un module, si vous ne l'avez pas déjà et déplacez votre code existant dans il.
Il est également maintenant l'impression de l'un des Onglets, pas les deux.
Si votre déclaration est erronée, sauf si vous êtes vraiment comparer à la chaîne de faux.
If filename <> "" Then
aurait suffit généralement dans de tels cas. Vous avez deux sections de la feuille de code. Ma fonction n'affecte pas ceux de toute façon. Vous devez mettre à jour les références de lafilename
en fonction de vos besoins. Aussi, selon l'endroit où ce code est appelé vous pourriez avoir besoin pour faire référence à la Feuille defilename = GetFileName(Sheets("Rental").Range("O1"))
par exemple. Debug plus et laissez-moi savoir.Désolé, je suis encore assez nouveau pour VBA et vous ne savez pas où je suis allé mal. J'ai toujours une Erreur 1004. J'ai enlevé l'instruction if et changé les noms de chaîne - Worksheets("Location").Activer filenamerental = GetFileName(Sheets("Location").Range("O1")) Avec ActiveWorkbook .Worksheets("Location").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _ filename:=filenamerental, _ la Qualité de l':=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End Avec
Éviter de mettre du code dans les commentaires. C'est très difficile à lire parfois. Mise à jour de la question. Je viens de tester et ne pas avoir des problèmes. J'ai mis à jour ma réponse.
OriginalL'auteur Matt