【审计工具】6.征信报告转excel

import pdfplumberfrom openpyxl import Workbookpdf_path = r"D:\征信报告.pdf"xlsx_path = r"D:\征信报告.xlsx"def words_to_lines(words, tol=3):    if not words:        return []    words = sorted(words, key=lambda w: (w["top"], w["x0"]))    lines, current, anchor = [], [], None    for w in words:        if anchor is None or abs(w["top"] - anchor) <= tol:            current.append(w)            if anchor is None:                anchor = w["top"]        else:            lines.append(current)            current, anchor = [w], w["top"]    if current:        lines.append(current)    out = []    for line in lines:        line = sorted(line, key=lambda w: w["x0"])        top = min(w["top"] for w in line)        text = " ".join(w["text"] for w in line)        out.append((top, text))    return outtry:    with pdfplumber.open(pdf_path) as p:        wb = Workbook()        wb.remove(wb.worksheets[0])        for index, page in enumerate(p.pages, start=1):            ws = wb.create_sheet(f"Sheet{index}")            blocks = []            tables = page.find_tables()            table_bboxes = [t.bbox for t in tables]            for t in tables:                rows_text = t.extract()                for i, row in enumerate(t.rows):                    top = row.bbox[1]                    blocks.append((top, "table", rows_text[i]))            words = page.extract_words()            outside = [w for w in words                       if not any(w["x0"] >= x0 and w["x1"] <= x1 and                                  w["top"] >= top and w["bottom"] <= bottom                                  for (x0, top, x1, bottom) in table_bboxes)]            for top, text in words_to_lines(outside):                blocks.append((top, "text", text))            blocks.sort(key=lambda b: b[0])            for _, kind, content in blocks:                if kind == "table":                    ws.append(content)                else:                    ws.append([content])        wb.save(xlsx_path)    print("转换完成")except Exception as e:    print("转换失败")    print(e)   # 打印具体异常，便于定位问题（可删）

"C:\Users\AveryGuiye\Desktop\压缩\新建 XLSX 工作表.xlsx"

"C:\\Users\\AveryGuiye\\Desktop\\压缩\\新建 XLSX 工作表.xlsx"

Sub 合并所有表到新表_带来源()    Dim wbTarget As Workbook    Dim wsTarget As Worksheet    Dim ws As Worksheet    Dim pasteRow As Long    Dim i As Long, n As Long    Dim srcRows As Long    Dim sheetNames() As String    Dim newName As String, k As Long    Set wbTarget = ActiveWorkbook   ' 操作当前激活的工作簿（和你的其他宏一致）    n = wbTarget.Worksheets.Count    ReDim sheetNames(1 To n)    For i = 1 To n        sheetNames(i) = wbTarget.Worksheets(i).Name    Next i    Set wsTarget = wbTarget.Worksheets.Add(Before:=wbTarget.Worksheets(1))    newName = "合并": k = 1    Do While SheetExistsIn(wbTarget, newName)        newName = "合并" & k: k = k + 1    Loop    wsTarget.Name = newName    wsTarget.Cells(1, 1).Value = "来源表"    pasteRow = 2    For i = 1 To n        Set ws = wbTarget.Worksheets(sheetNames(i))        If Application.WorksheetFunction.CountA(ws.UsedRange) > 0 Then            srcRows = ws.UsedRange.Rows.Count            ws.UsedRange.Copy            wsTarget.Cells(pasteRow, 2).PasteSpecial Paste:=xlPasteValues            wsTarget.Range(wsTarget.Cells(pasteRow, 1), _                           wsTarget.Cells(pasteRow + srcRows - 1, 1)).Value = ws.Name            pasteRow = pasteRow + srcRows        End If    Next i    Application.CutCopyMode = False    MsgBox "合并完成！新表名称：" & newName, vbInformationEnd SubFunction SheetExistsIn(wb As Workbook, sName As String) As Boolean    Dim sh As Worksheet    On Error Resume Next    Set sh = wb.Worksheets(sName)    SheetExistsIn = Not sh Is Nothing    On Error GoTo 0End Function