Excel Daten auslesen mit Word Makro
07.04.2020 13:02:34
Geogar
ThisWorkbook.Worksheets("Statistik").Unprotect "1"
ThisWorkbook.Worksheets("Statistik").Protect "1"
einbauen soll. Die Excel-Datei befindet sich im selben Ordner wie das Word-Dokument. Ich habe einen Code zusammengestellt, die beiden Quellen stehen oben im Code, jedoch wird mir hier "Laufzeitfehler" angezeigt. Auch, wenn ich den Schreibschutz raus nehme, da ich wie gesagt nicht weiß, wie ich den Code dafür einbauen soll. Hier jetzt der Code und danke schonmal im vorraus :)
Sub PDF_Speichern()
'https://www.pctipp.ch/praxis/office/word-makro-fuers-speichern-als-pdf-1961452.html
'https://www.herber.de/forum/archiv/196to200/199449_Excel_Daten_von_Word_auslesen.html
Dim strDateiname As String
Dim strPfad As String
Dim strPDF As String
Dim intPosition As Integer
Dim intLaenge As Integer
Dim intEndung As Integer
Dim iCounter As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlWkb = xlApp.Workbooks.Open(ActiveDocument.Path & "\" & "Haupttabelle 3.1.xlsm")
Set xlWks = xlWkb.Worksheets(1)
Set rng = xlWks.Range("E1").CurrentRegion
strPfad = xlWks.Range("E1").CurrentRegion
strDateiname = ActiveDocument.Name
intLaenge = Len(strDateiname)
intPosition = InStrRev(strDateiname, ".")
Select Case intEndung
Case 0
strPDF = strPfad & strDateiname & ".pdf"
Case 3
strDateiname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3)
strPDF = strPfad & strDateiname & Left(strDateiname, i) & "pdf"
Case 4
strDateiname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
strPDF = strPfad & strDateiname & Left(strDateiname, i) & "pdf"
Case Else
MsgBox "Die Dateiendung wurde nicht erkannt!", vbExclamation, "Unbekannte Dateiendung"
End Select
ActiveDocument.ExportAsFixedFormat OutputFileName:=strPDF, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
End Sub