怎样将电子表格另存为Word或者pdf格式。

smxxjwc

怎样将电子表格另存为Word或者pdf格式。

ykcbf1100

上个求助帖不是已经解决了吗？

smxxjwc

ykcbf1100 发表于 2024-9-19 15:53
上个求助帖不是已经解决了吗？

这是另外一个格式

ykcbf1100

smxxjwc 发表于 2024-9-19 16:47
这是另外一个格式

EXCEl无法直接另存为word格式的，只能另存为PDF格式。

smxxjwc

Sub SaveWorkbookAsPDFInSameFolder()
    Dim savePath As String
   
    ' 获取当前工作簿的路径
    savePath = ThisWorkbook.Path
   
    ' 拼接文件名和路径，使用工作簿的名称作为PDF的文件名
    savePath = savePath & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(".xlsx")) & ".pdf"
   
    ' 将当前工作簿另存为PDF
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    ' 可选：添加消息框提示保存成功
    MsgBox "PDF文件已保存到: " & savePath
End Sub

smxxjwc

Sub 导出为word()
    ' 声明变量...
    Dim rng As Range, ws As Worksheet
    Dim djq As String '第几期
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = ThisWorkbook.Sheets("Sheet2")
    ' 获取期数...
    djq = ws.Range("K1").Value & ws.Range("L1").Value & ws.Range("M1").Value
    Set rng = ws.Range("A1:H10")
   
    Dim wordApp As Object
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False
    wordApp.Documents.Add
    rng.Copy
    wordApp.Selection.PasteExcelTable False, False, False
   
    ' 设置页面边距为1.2厘米
    With wordApp.ActiveDocument.PageSetup
        .TopMargin = CentimetersToPoints(1.2)
        .BottomMargin = CentimetersToPoints(1.2)
        .LeftMargin = CentimetersToPoints(1.2)
        .RightMargin = CentimetersToPoints(1.2)
    End With
   
    ' 设置Word表格里的字体大小和行距
    With wordApp.Selection.Tables(1)
        .Range.Font.Size = 12 ' 设置字体大小为12磅（小四）
        .Range.Paragraphs.LineSpacingRule = wdLineSpaceExactly ' 设置行距为固定值
        .Range.Paragraphs.LineSpacing = 18 ' 设置行距为18磅
    End With
   
    wordApp.ActiveDocument.SaveAs fileName:=ThisWorkbook.Path & "\" & djq & ".docx"
    wordApp.ActiveDocument.Close
    wordApp.Quit
   
    ' 清理并恢复设置...
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "导出成功！ 文件的全路径为：" & Chr(10) & ThisWorkbook.Path & "\" & djq & ".docx"
End Sub

' 自定义函数：将厘米转换为磅
Function CentimetersToPoints(ByVal Centimeters As Double) As Double
    Const PointsPerCentimeter As Double = 28.3464566929134
    CentimetersToPoints = Centimeters * PointsPerCentimeter
End Function