|
Option Explicit
Private Sub Anzahl_PDF_Seiten_Change()
' Bei Änderung der Anzahl das Einlesen/Formatieren erneut erlauben
Hinweise_einlesen.Enabled = True
'Hinweise_formatieren.Enabled = True
End Sub
Private Sub Hinweise_einlesen_Click()
Dim t_PDFApp As AcroApp
Dim t_FileName As String
Dim t_PDFPDDoc As AcroPDDoc
Dim t_PDFAVDoc As AcroAVDoc
Dim t_objJSO As Object
Dim Ergebnis As Boolean
Dim XlsxWorkbook As Workbook
Dim CSVZeile As String
Dim t_PDFPDTextSelect As AcroPDTextSelect
Dim t_Anzahl_PDF_Seiten As Integer
Hinweise_einlesen.Enabled = False
t_FileName = Application.Sheets(1).Range(t_FileNamesRange).Cells(1, 1).Value
If t_FileName = "" Then
MsgBox "Bitte Quelldatei wählen"
Exit Sub
End If
' Daten holen
Load Wait
Wait.Show vbModeless
If t_PDFApp Is Nothing Then
Set t_PDFApp = CreateObject("AcroExch.App")
End If
Set t_PDFAVDoc = CreateObject("AcroExch.AVDoc")
DoEvents
Call t_PDFAVDoc.Open(t_FileName, "Code File")
DoEvents
Set t_PDFPDDoc = t_PDFAVDoc.GetPDDoc
t_Anzahl_PDF_Seiten = Einordnungshinweise.Anzahl_PDF_Seiten
Tabelle1.Set_Seitenzahl (t_Anzahl_PDF_Seiten)
Set t_objJSO = t_PDFPDDoc.GetJSObject
With New FileSystemObject
If .FileExists(Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx") Then
.DeleteFile Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx"
End If
If .FileExists(Application.ThisWorkbook.Path & "\_Temp_CSV.csv") Then
.DeleteFile Application.ThisWorkbook.Path & "\_Temp_CSV.csv"
End If
End With
Ergebnis = t_PDFPDDoc.DeletePages(t_Anzahl_PDF_Seiten, t_PDFPDDoc.GetNumPages - 1)
Ergebnis = t_objJSO.SaveAs(Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx", "com.adobe.acrobat.xlsx")
Ergebnis = t_PDFAVDoc.Close(True)
Set XlsxWorkbook = Workbooks.Open(Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx")
Application.UseSystemSeparators = False
Application.DecimalSeparator = "."
XlsxWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\_Temp_CSV.csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
XlsxWorkbook.Close False
Application.UseSystemSeparators = True
Open Application.ThisWorkbook.Path & "\_Temp_CSV.csv" For Input As #1
Hinweise_RAW.Text = Input(LOF(1), 1)
Close #1
With New FileSystemObject
If .FileExists(Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx") Then
.DeleteFile Application.ThisWorkbook.Path & "\_Temp_XLSX.xlsx"
End If
If .FileExists(Application.ThisWorkbook.Path & "\_Temp_CSV.csv") Then
.DeleteFile Application.ThisWorkbook.Path & "\_Temp_CSV.csv"
End If
End With
Application.ThisWorkbook.Activate
Hinweise_RAW.Text = Replace(Hinweise_RAW.Text, "Blätter", "Blätter" & vbCr)
t_PDFAVDoc.Close (0)
t_PDFApp.CloseAllDocs
DoEvents
Set t_PDFAVDoc = Nothing
Set t_PDFPDDoc = Nothing
Call t_PDFApp.Exit
DoEvents
Set t_PDFApp = Nothing
Call Hinweise_formatieren
Unload Wait
End Sub
Private Sub Hinweise_formatieren()
Dim t_Hinweise_RAW, t_TempTrenner, t_CSVQoutes As String
Dim t_Hinweis_RAW, t_Hinweis_RAW_Seiten As Integer
Dim ReverseString As String
' Suchen und ersetzen
'Hinweise_formatieren.Enabled = False
Dim t_Hinweise_RAW_array() As String
t_Hinweise_RAW = Hinweise_RAW.Text
Debug.Print Hinweise_RAW.Text
t_Hinweise_RAW_array = Split(t_Hinweise_RAW, vbCr)
For t_Hinweis_RAW = LBound(t_Hinweise_RAW_array) To UBound(t_Hinweise_RAW_array)
't_Hinweis_RAW_Titel = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
t_CSVQoutes = ";" & Chr(34) & ";"
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_CSVQoutes, ";")
t_CSVQoutes = ";" & Chr(34)
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_CSVQoutes, ";")
t_CSVQoutes = Chr(34) & ";"
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_CSVQoutes, ";")
t_CSVQoutes = ";"
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_CSVQoutes, vbTab)
If Left(t_Hinweise_RAW_array(t_Hinweis_RAW), 1) = Chr(34) Then
t_Hinweise_RAW_array(t_Hinweis_RAW) = Right(t_Hinweise_RAW_array(t_Hinweis_RAW), Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - 1)
End If
If Right(t_Hinweise_RAW_array(t_Hinweis_RAW), 1) = Chr(34) Then
t_Hinweise_RAW_array(t_Hinweis_RAW) = Left(t_Hinweise_RAW_array(t_Hinweis_RAW), Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - 1)
End If
Do While Right(t_Hinweise_RAW_array(t_Hinweis_RAW), 1) = vbTab Or Right(t_Hinweise_RAW_array(t_Hinweis_RAW), 1) = " "
t_Hinweise_RAW_array(t_Hinweis_RAW) = Left(t_Hinweise_RAW_array(t_Hinweis_RAW), Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - 1)
Loop
t_TempTrenner = " – "
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_TempTrenner, vbTab)
t_TempTrenner = "– "
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_TempTrenner, vbTab)
t_TempTrenner = " –"
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_TempTrenner, vbTab)
t_TempTrenner = "–"
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), t_TempTrenner, vbTab)
Do While InStr(t_Hinweise_RAW_array(t_Hinweis_RAW), " ") > 0
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), " ", vbTab)
Loop
Do While InStr(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab & vbTab) > 0
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab & vbTab, vbTab)
Loop
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab & " ", vbTab)
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), " " & vbTab, vbTab)
If Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - Len(Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab, "")) = 2 Then
t_Hinweise_RAW_array(t_Hinweis_RAW) = Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab, vbTab & vbTab & vbTab)
End If
If Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - Len(Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab, "")) > 6 Then
ReverseString = StrReverse(t_Hinweise_RAW_array(t_Hinweis_RAW))
ReverseString = Replace(ReverseString, vbTab & vbTab, vbTab, 1, (Len(t_Hinweise_RAW_array(t_Hinweis_RAW)) - Len(Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab, "")) - 6))
t_Hinweise_RAW_array(t_Hinweis_RAW) = StrReverse(ReverseString)
End If
Next
Hinweise_RAW.Text = ""
Hinweise_RAW.Font.Name = "Arial"
Hinweise_RAW.Font.Bold = False
Hinweise_RAW.Font.Size = 12
Hinweise_RAW.Text = Join(t_Hinweise_RAW_array, vbCr)
End Sub
Private Sub Hinweise_RAW_Click()
End Sub
Private Sub Hinweise_uebernehmen_Click()
Dim t_Hinweise_RAW, t_Hinweis_RAW_Teil As String
Dim t_Hinweise_RAW_array() As String
Dim t_Hinweis_RAW As Integer
Dim Lastcell As Range
t_Hinweise_RAW = Hinweise_RAW.Text
t_Hinweise_RAW_array = Split(t_Hinweise_RAW, vbCr)
Application.EnableEvents = False
Application.Sheets(1).Range(t_VorgabePDFRange) = ""
Application.Sheets(1).Range(t_ZielPDFRange) = ""
Application.Sheets(1).Range(t_QuellPDFTitelRange) = ""
Application.Sheets(1).Range(t_QuellPDFRange) = ""
For t_Hinweis_RAW = LBound(t_Hinweise_RAW_array) To UBound(t_Hinweise_RAW_array)
If Trim(Replace(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab, "")) <> "" Then
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + 2, 1).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" And t_Hinweise_RAW_array(t_Hinweis_RAW) <> "" Then t_Hinweis_RAW_Teil = "-" '"-"
Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + 2, 2).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" And t_Hinweise_RAW_array(t_Hinweis_RAW) <> "" Then t_Hinweis_RAW_Teil = "-" '"-"
Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + 2, 3).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" And t_Hinweise_RAW_array(t_Hinweis_RAW) <> "" Then t_Hinweis_RAW_Teil = 0
Application.Sheets(1).Range(t_ZielPDFRange).Cells(t_Hinweis_RAW + 2, 3).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" And t_Hinweise_RAW_array(t_Hinweis_RAW) <> "" Then t_Hinweis_RAW_Teil = "-" '"-"
Application.Sheets(1).Range(t_QuellPDFTitelRange).Cells(t_Hinweis_RAW + 2, 1).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" And t_Hinweise_RAW_array(t_Hinweis_RAW) <> "" Then t_Hinweis_RAW_Teil = "-" '"-"
Application.Sheets(1).Range(t_QuellPDFTitelRange).Cells(t_Hinweis_RAW + 2, 2).Value = t_Hinweis_RAW_Teil
t_Hinweis_RAW_Teil = ZerteilenFeld(t_Hinweise_RAW_array(t_Hinweis_RAW), vbTab)
If t_Hinweis_RAW_Teil = "" Then t_Hinweis_RAW_Teil = 0 'And t_Hinweise_RAW_array(t_Hinweis_RAW) <> ""
Application.Sheets(1).Range(t_QuellPDFRange).Cells(t_Hinweis_RAW + 2, 2).Value = t_Hinweis_RAW_Teil
End If
Next
Set Lastcell = Application.Sheets(1).Cells.Find(What:="*", After:=Application.Sheets(1).Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
For t_Hinweis_RAW = LBound(t_Hinweise_RAW_array) To UBound(t_Hinweise_RAW_array)
Dim Leerzeile As Integer
Leerzeile = 1
Do While Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 1).Value = ""
Debug.Print Lastcell.Row
Debug.Print Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 1).Row
Debug.Print Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 2).Row
Debug.Print Lastcell.Row <= Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 2).Row
Debug.Print Lastcell.Row <= Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 1).Row
If (Lastcell.Row <= Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 1, 1).Row And Lastcell.Row <= Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 2).Row) Then
Exit Do
End If
Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + Leerzeile + 2, 1).Value = Application.Sheets(1).Range(t_VorgabePDFRange).Cells(t_Hinweis_RAW + 2, 1).Value
Leerzeile = Leerzeile + 1
Loop
Next
Call Tabelle1.Quellseiten_Berechnen
Application.EnableEvents = True
Call Tabelle1.Schluessel_pruefen
Unload Me
End Sub
Private Sub HinweiseRAW_Click()
End Sub
Private Sub UserForm_Activate()
Dim t_tab As Integer
Dim t_hwnd&, t_hwnd_child&, t_class$
Dim t_tabs(6) As Long
t_tabs(0) = 40 * 4
For t_tab = 1 To UBound(t_tabs)
t_tabs(t_tab) = t_tabs(t_tab - 1) + 13 * 4
Next
Dim t_tabscount As Long
t_tabscount = UBound(t_tabs) - LBound(t_tabs) + 1
Dim asdf As Long
asdf = FindWindow("Einordnungshinweise", vbNullString)
'SendMessage Hinweise_RAW.hwnd, EM_SETTABSTOPS, t_tabscount, t_tabs(LBound(t_tabs))
Hinweise_einlesen.Enabled = True
End Sub
|