txt als pdf speichern

Hallo Gemeinde,
mit diesem Code wird der gesamt VBA code als txt Datei gespeichert.

Option Explicit
Sub ExportModules()         ' Ordner erstellen
'prüfen ob ein Ordner vorhanden ist und falls nicht
'fragen ob Ordner erstellt werden soll
Dim Ord As String
Dim Antwort As Integer
Ord = "C:\Users\VBA CODE"
'  If Dir(Ord, vbDirectory)  "" Then
'      MsgBox "Ordner ist schon vorhanden"
'  Else
'  Antwort = MsgBox("Der Ordner " & Ord & " ist nicht vorhanden." _
'          & vbNewLine _
'          & "soll der Ordner angelegt werden?!", vbYesNo)
'      If Antwort = vbYes Then
''Falls kein LW angegeben ist, erstellt die MkDir-Anweisung
''den neuen Ordner auf dem aktuellen LW.
''LW wurde aber durch "C:\Eigene Dateien\Teste" festgelegt
'      MkDir Ord
'      MsgBox "Ordner " & Ord & " angelegt"
'      Else
'      MsgBox "Es wurden keine Änderungen vorgenommen"
'      Exit Sub
'      End If
'  End If
Dim VBComp As Object, objFile As Object 'Code als txt Datei exportieren
Dim i As Long, TaskId As Double
Set objFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(Ord & "/" & UserForm1. _
TextBox1.Text & "-VBA.txt", 2, True)
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
objFile.WriteLine vbCrLf & VBComp.Name & vbCrLf
With VBComp.CodeModule
i = 1
Do Until i > .CountOfLines
objFile.WriteLine .Lines(i, 1)
i = i + 1
Loop
End With
objFile.WriteLine
Next VBComp
objFile.Close
MsgBox "Code gespeichert"
'    TaskId = Shell("notepad.exe " & ThisWorkbook.paTh & "\VBA.txt", vbNormalFocus)
End Sub

Ich tue es aus Sicherheitsgründe, (in der Vergangenheit konnte ich ein Projekt nicht mehr öffnen und immerhin waren ein Paar Monate Arbeit).
Ich würde gerne die txt Datei auch als pdf speichern können, wie kann ich den Makro so ändern oder ergänzen das eine txt und eine pdf Datei erzeugt werden?
Vielen Dank in Voraus
Antonio

Hallo Antonio,
hier ein Makro mit dem die Text-Datei via Excel als PDF gespeichert wird.
LG
Franz

Option Explicit
Sub ExportModules()         ' Ordner erstellen
'    TaskId = Shell("notepad.exe " & ThisWorkbook.paTh & "\VBA.txt", vbNormalFocus)
Call prcSaveTXT_as_PDF_viaExcel(strFileTXT:=ThisWorkbook.paTh & "\VBA.txt, _
strFilePDF:=ThisWorkbook.paTh & "\VBA.pdf)
End Sub

'Erstellt unter Excel 2010
Sub prcSaveTXT_as_PDF_viaExcel(strFileTXT$, strFilePDF$, Optional bolPDF_anzeigen As Boolean)
'strFileTXT = Name der Text-Datei inkl. Pfad
'strFilePDF = Name der PDF-Datei inkl. Pfad
Dim wksPDF As Worksheet, wkbPDF As Workbook
Dim strFileXLS$
'Textdatei Öffnen
Application.Workbooks.OpenText Filename:=strFileTXT, Origin:=xlWindows, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=Array(1, 2), TrailingMinusNumbers:=False
Set wkbPDF = ActiveWorkbook
Set wksPDF = wkbPDF.Worksheets(1)
'Gitterlinien nicht anzeigen
ActiveWindow.DisplayGridlines = False
'Datei temporär als Excel-Datei speichern
strFileXLS = Left(strFileTXT, Len(strFileTXT) - 3) & "xls"
ActiveWorkbook.SaveAs Filename:=strFileXLS, FileFormat:=xlExcel8, Password:="",  _
WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False, addtomru:=False
'Schriftart setzen
With wkbPDF.Styles("Standard").Font
.Name = "Courier New" 'Font mit fester Länge - Nichtproportionalschrift
.Size = 11
End With
With wksPDF.Range("A:A")
.ColumnWidth = 117
.WrapText = True
End With
'Seitenlayout formatieren
With wksPDF.PageSetup
.PrintGridlines = False
.Orientation = xlLandscape 'Querformat
.LeftMargin = Application.CentimetersToPoints(1)
.RightMargin = Application.CentimetersToPoints(1)
.TopMargin = Application.CentimetersToPoints(1.8)
.BottomMargin = Application.CentimetersToPoints(1.5)
.CenterHeader = strFileTXT
.CenterFooter = "&P von &N"
End With
'als PDF speichern
wksPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=bolPDF_anzeigen
wkbPDF.Close savechanges:=True
'temporäre Exceldatei wieder löschen
If Dir(strFileXLS)  "" Then Kill strFileXLS
End Sub

Forumthread: txt als pdf speichern

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial