再看看
|
本帖最后由 cutebe 于 2026-2-5 17:39 编辑
|
| 财务还是让公司买一套软件吧,财务软件有基础的报表打印功能的.开源节流事半功倍。 |
cutebe 发表于 2026-2-5 11:30 这下不报错了,你这个直接开始打印了,不要直接打印,只调格式就好;还有以下问题,麻烦您看一下第2个工作表:将所有列调整为一页;AE5单元格:所有框线;6行行高:44;插入页脚:第1页,共2页; 谢谢老师 |
| 啊? |
zhoubin 发表于 2026-2-5 09:20 15张表格都做好了。 |
狼人72105 发表于 2026-2-5 11:22 报告大佬,你的代码,一直运行,停不下来,也关不掉 |
|
本帖最后由 cutebe 于 2026-2-5 11:53 编辑 另存为时,编码选ANSI 再截图看下(报错的第15行)你复制的代码,要去掉行号 |
|
Option Explicit Sub MonthPrint_Optimized() ' MonthPrint 优化版宏 ' 打印月年报 - 修复和优化版本 On Error GoTo ErrorHandler ' 定义工作表数组 Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim startTime As Double startTime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Dim ws As Worksheet Dim sheetName As Variant ' 批量处理所有工作表 For Each sheetName In sheetNames On Error Resume Next Set ws = ThisWorkbook.Sheets(CStr(sheetName)) On Error GoTo ErrorHandler If Not ws Is Nothing Then ' 应用基础打印设置 ApplyBasePrintSettings ws ' 根据工作表名称应用特定设置 Select Case CStr(sheetName) Case "000" ApplySheet000Settings ws Case "003" ApplySheet003Settings ws Case "002" ApplySheet002Settings ws Case "100", "101", "102", "104", "105", "106", "107" ApplyGeneralSheetSettings ws Case "108", "109", "900", "103", "001" ApplyGeneralSheetSettings ws ' 可以为每个表添加特定设置 If CStr(sheetName) = "001" Then ApplySheet001Settings ws End If End Select Set ws = Nothing End If Next sheetName CleanUp: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Dim elapsedTime As Double elapsedTime = Timer - startTime MsgBox "打印设置完成!耗时: " & Format(elapsedTime, "0.00") & "秒", vbInformation Exit Sub ErrorHandler: MsgBox "错误发生: " & Err.Description & vbCrLf & _ "错误号: " & Err.Number & vbCrLf & _ "工作表: " & IIf(ws Is Nothing, "N/A", ws.Name), vbCritical Resume CleanUp End Sub ' 基础打印设置子程序 Private Sub ApplyBasePrintSettings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 页边距设置 .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) ' 基本打印选项 .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = False .CenterVertically = False .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False ' 清空页眉页脚 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" ' 偶数页页眉页脚 .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" ' 首页页眉页脚 .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub ' 工作表000的特定设置 Private Sub ApplySheet000Settings(ws As Worksheet) With ws.PageSetup .Orientation = xlPortrait .FitToPagesWide = 1 .FitToPagesTall = 0 End With End Sub ' 工作表003的特定设置 Private Sub ApplySheet003Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 设置为横向 .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False ' 打印区域 .PrintArea = "$A$1:$BF$80" .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.669) .BottomMargin = Application.InchesToPoints(0.591) End With Application.PrintCommunication = True ' 设置列宽和行高 With ws ' 设置列宽 .Columns("C:BF").ColumnWidth = 1.88 .Columns("E:E").ColumnWidth = 7.5 .Columns("F:F").ColumnWidth = 7.5 .Columns("AS:AS").ColumnWidth = 7.5 .Columns("AT:AT").ColumnWidth = 7.5 .Columns("BF:BF").ColumnWidth = 11.29 ' 设置行高 .Rows("1:1").RowHeight = 10.5 .Rows("2:2").RowHeight = 27 .Rows("3:3").RowHeight = 44.25 .Rows("7:7").RowHeight = 81 .Rows("8:80").RowHeight = 18 ' 设置字体 .Range("C10:BF80").Font.Name = "宋体" .Range("C10:BF80").Font.Size = 9 .Range("A4:BF80").Font.Size = 10 ' 替换文本 .Range("AT3").Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart .Range("BF3").Value = "表号:003" & Chr(10) & "金额单位:万元" End With End Sub ' 工作表002的特定设置 Private Sub ApplySheet002Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$4" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.709) .BottomMargin = Application.InchesToPoints(0.63) End With Application.PrintCommunication = True With ws ' 设置行高 .Rows("1:1").RowHeight = 17.25 .Rows("2:2").RowHeight = 20.25 .Rows("3:3").RowHeight = 26.25 .Rows("4:75").RowHeight = 14 ' 设置列宽 .Columns("F:F").ColumnWidth = 47.57 ' 设置字体 .Range("F31,F69,F70").Font.Name = "宋体" .Range("F31,F69,F70").Font.Size = 6 End With End Sub ' 工作表001的特定设置 Private Sub ApplySheet001Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.984) .BottomMargin = Application.InchesToPoints(0.827) End With Application.PrintCommunication = True With ws ' 设置列宽 .Columns("C:AF").ColumnWidth = 9 End With End Sub ' 通用工作表设置 Private Sub ApplyGeneralSheetSettings(ws As Worksheet) ' 默认设置为横向 With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False End With ' 替换所有工作表中的"金额单位:?$" On Error Resume Next ws.Cells.Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart On Error GoTo 0 End Sub ' 快捷打印宏 Sub QuickPrintAll() ' 直接打印所有配置好的工作表 On Error GoTo PrintError Application.ScreenUpdating = False Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim wsNames() As String ReDim wsNames(0 To UBound(sheetNames)) Dim i As Long For i = 0 To UBound(sheetNames) wsNames(i) = CStr(sheetNames(i)) Next i ' 选择并打印所有工作表 ThisWorkbook.Sheets(wsNames).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True CleanUp: Application.ScreenUpdating = True Exit Sub PrintError: MsgBox "打印错误: " & Err.Description, vbExclamation Resume CleanUp End Sub ' 恢复默认设置(可选) Sub ResetPrintSettings() Dim ws As Worksheet Dim response As VbMsgBoxResult response = MsgBox("确定要重置所有工作表的打印设置吗?", vbYesNo + vbQuestion, "确认重置") If response = vbYes Then Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws.PageSetup ' 恢复默认设置 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Zoom = 100 .PrintArea = "" .PrintTitleRows = "" .PrintTitleColumns = "" End With Next ws Application.ScreenUpdating = True MsgBox "打印设置已重置为默认值!", vbInformation End If End Sub |
zhoubin 发表于 2026-2-5 08:55 笨蛋,你直接复制的,没有分行,怎么运行? |
|
金山WPS正常,可能是MS的不支持中文
|
zhoubin 发表于 2026-2-4 21:52 把决算.xls拖入JS文件图标上
|
|
又调整了,刚看到 |
| 不想做模版或代码的话,直接在要复制格式的文件上右键新建即可,会快速生成个新文件。 |
| 将要求具体清晰告诉DS,让它帮做个网页版的表,或用现有表让它邦做宏,它会教你如何用的 |
本帖最后由 ohte 于 2026-2-5 09:25 编辑 zhoubin 发表于 2026-2-4 21:52
|
| Option Explicit Sub MonthPrint_Optimized() ' MonthPrint 优化版宏 ' 打印月年报 - 修复和优化版本 On Error GoTo ErrorHandler ' 定义工作表数组 Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim startTime As Double startTime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Dim ws As Worksheet Dim sheetName As Variant ' 批量处理所有工作表 For Each sheetName In sheetNames On Error Resume Next Set ws = ThisWorkbook.Sheets(CStr(sheetName)) On Error GoTo ErrorHandler If Not ws Is Nothing Then ' 应用基础打印设置 ApplyBasePrintSettings ws ' 根据工作表名称应用特定设置 Select Case CStr(sheetName) Case "000" ApplySheet000Settings ws Case "003" ApplySheet003Settings ws Case "002" ApplySheet002Settings ws Case "100", "101", "102", "104", "105", "106", "107" ApplyGeneralSheetSettings ws Case "108", "109", "900", "103", "001" ApplyGeneralSheetSettings ws ' 可以为每个表添加特定设置 If CStr(sheetName) = "001" Then ApplySheet001Settings ws End If End Select Set ws = Nothing End If Next sheetName CleanUp: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Dim elapsedTime As Double elapsedTime = Timer - startTime MsgBox "打印设置完成!耗时: " & Format(elapsedTime, "0.00") & "秒", vbInformation Exit Sub ErrorHandler: MsgBox "错误发生: " & Err.Description & vbCrLf & _ "错误号: " & Err.Number & vbCrLf & _ "工作表: " & IIf(ws Is Nothing, "N/A", ws.Name), vbCritical Resume CleanUp End Sub ' 基础打印设置子程序 Private Sub ApplyBasePrintSettings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 页边距设置 .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) ' 基本打印选项 .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = False .CenterVertically = False .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False ' 清空页眉页脚 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" ' 偶数页页眉页脚 .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" ' 首页页眉页脚 .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub ' 工作表000的特定设置 Private Sub ApplySheet000Settings(ws As Worksheet) With ws.PageSetup .Orientation = xlPortrait .FitToPagesWide = 1 .FitToPagesTall = 0 End With End Sub ' 工作表003的特定设置 Private Sub ApplySheet003Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 设置为横向 .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False ' 打印区域 .PrintArea = "$A$1:$BF$80" .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.669) .BottomMargin = Application.InchesToPoints(0.591) End With Application.PrintCommunication = True ' 设置列宽和行高 With ws ' 设置列宽 .Columns("C:BF").ColumnWidth = 1.88 .Columns("E:E").ColumnWidth = 7.5 .Columns("F:F").ColumnWidth = 7.5 .Columns("AS:AS").ColumnWidth = 7.5 .Columns("AT:AT").ColumnWidth = 7.5 .Columns("BF:BF").ColumnWidth = 11.29 ' 设置行高 .Rows("1:1").RowHeight = 10.5 .Rows("2:2").RowHeight = 27 .Rows("3:3").RowHeight = 44.25 .Rows("7:7").RowHeight = 81 .Rows("8:80").RowHeight = 18 ' 设置字体 .Range("C10:BF80").Font.Name = "宋体" .Range("C10:BF80").Font.Size = 9 .Range("A4:BF80").Font.Size = 10 ' 替换文本 .Range("AT3").Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart .Range("BF3").Value = "表号:003" & Chr(10) & "金额单位:万元" End With End Sub ' 工作表002的特定设置 Private Sub ApplySheet002Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$4" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.709) .BottomMargin = Application.InchesToPoints(0.63) End With Application.PrintCommunication = True With ws ' 设置行高 .Rows("1:1").RowHeight = 17.25 .Rows("2:2").RowHeight = 20.25 .Rows("3:3").RowHeight = 26.25 .Rows("4:75").RowHeight = 14 ' 设置列宽 .Columns("F:F").ColumnWidth = 47.57 ' 设置字体 .Range("F31,F69,F70").Font.Name = "宋体" .Range("F31,F69,F70").Font.Size = 6 End With End Sub ' 工作表001的特定设置 Private Sub ApplySheet001Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.984) .BottomMargin = Application.InchesToPoints(0.827) End With Application.PrintCommunication = True With ws ' 设置列宽 .Columns("C:AF").ColumnWidth = 9 End With End Sub ' 通用工作表设置 Private Sub ApplyGeneralSheetSettings(ws As Worksheet) ' 默认设置为横向 With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False End With ' 替换所有工作表中的"金额单位:?$" On Error Resume Next ws.Cells.Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart On Error GoTo 0 End Sub ' 快捷打印宏 Sub QuickPrintAll() ' 直接打印所有配置好的工作表 On Error GoTo PrintError Application.ScreenUpdating = False Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim wsNames() As String ReDim wsNames(0 To UBound(sheetNames)) Dim i As Long For i = 0 To UBound(sheetNames) wsNames(i) = CStr(sheetNames(i)) Next i ' 选择并打印所有工作表 ThisWorkbook.Sheets(wsNames).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True CleanUp: Application.ScreenUpdating = True Exit Sub PrintError: MsgBox "打印错误: " & Err.Description, vbExclamation Resume CleanUp End Sub ' 恢复默认设置(可选) Sub ResetPrintSettings() Dim ws As Worksheet Dim response As VbMsgBoxResult response = MsgBox("确定要重置所有工作表的打印设置吗?", vbYesNo + vbQuestion, "确认重置") If response = vbYes Then Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws.PageSetup ' 恢复默认设置 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Zoom = 100 .PrintArea = "" .PrintTitleRows = "" .PrintTitleColumns = "" End With Next ws Application.ScreenUpdating = True MsgBox "打印设置已重置为默认值!", vbInformation End If End Sub |
| Option Explicit Sub MonthPrint_Optimized() ' MonthPrint 优化版宏 ' 打印月年报 - 修复和优化版本 On Error GoTo ErrorHandler ' 定义工作表数组 Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim startTime As Double startTime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Dim ws As Worksheet Dim sheetName As Variant ' 批量处理所有工作表 For Each sheetName In sheetNames On Error Resume Next Set ws = ThisWorkbook.Sheets(CStr(sheetName)) On Error GoTo ErrorHandler If Not ws Is Nothing Then ' 应用基础打印设置 ApplyBasePrintSettings ws ' 根据工作表名称应用特定设置 Select Case CStr(sheetName) Case "000" ApplySheet000Settings ws Case "003" ApplySheet003Settings ws Case "002" ApplySheet002Settings ws Case "100", "101", "102", "104", "105", "106", "107" ApplyGeneralSheetSettings ws Case "108", "109", "900", "103", "001" ApplyGeneralSheetSettings ws ' 可以为每个表添加特定设置 If CStr(sheetName) = "001" Then ApplySheet001Settings ws End If End Select Set ws = Nothing End If Next sheetName CleanUp: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Dim elapsedTime As Double elapsedTime = Timer - startTime MsgBox "打印设置完成!耗时: " & Format(elapsedTime, "0.00") & "秒", vbInformation Exit Sub ErrorHandler: MsgBox "错误发生: " & Err.Description & vbCrLf & _ "错误号: " & Err.Number & vbCrLf & _ "工作表: " & IIf(ws Is Nothing, "N/A", ws.Name), vbCritical Resume CleanUp End Sub ' 基础打印设置子程序 Private Sub ApplyBasePrintSettings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 页边距设置 .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) ' 基本打印选项 .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = False .CenterVertically = False .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False ' 清空页眉页脚 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" ' 偶数页页眉页脚 .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" ' 首页页眉页脚 .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub ' 工作表000的特定设置 Private Sub ApplySheet000Settings(ws As Worksheet) With ws.PageSetup .Orientation = xlPortrait .FitToPagesWide = 1 .FitToPagesTall = 0 End With End Sub ' 工作表003的特定设置 Private Sub ApplySheet003Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup ' 设置为横向 .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False ' 打印区域 .PrintArea = "$A$1:$BF$80" .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.669) .BottomMargin = Application.InchesToPoints(0.591) End With Application.PrintCommunication = True ' 设置列宽和行高 With ws ' 设置列宽 .Columns("C:BF").ColumnWidth = 1.88 .Columns("E:E").ColumnWidth = 7.5 .Columns("F:F").ColumnWidth = 7.5 .Columns("AS:AS").ColumnWidth = 7.5 .Columns("AT:AT").ColumnWidth = 7.5 .Columns("BF:BF").ColumnWidth = 11.29 ' 设置行高 .Rows("1:1").RowHeight = 10.5 .Rows("2:2").RowHeight = 27 .Rows("3:3").RowHeight = 44.25 .Rows("7:7").RowHeight = 81 .Rows("8:80").RowHeight = 18 ' 设置字体 .Range("C10:BF80").Font.Name = "宋体" .Range("C10:BF80").Font.Size = 9 .Range("A4:BF80").Font.Size = 10 ' 替换文本 .Range("AT3").Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart .Range("BF3").Value = "表号:003" & Chr(10) & "金额单位:万元" End With End Sub ' 工作表002的特定设置 Private Sub ApplySheet002Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$4" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.709) .BottomMargin = Application.InchesToPoints(0.63) End With Application.PrintCommunication = True With ws ' 设置行高 .Rows("1:1").RowHeight = 17.25 .Rows("2:2").RowHeight = 20.25 .Rows("3:3").RowHeight = 26.25 .Rows("4:75").RowHeight = 14 ' 设置列宽 .Columns("F:F").ColumnWidth = 47.57 ' 设置字体 .Range("F31,F69,F70").Font.Name = "宋体" .Range("F31,F69,F70").Font.Size = 6 End With End Sub ' 工作表001的特定设置 Private Sub ApplySheet001Settings(ws As Worksheet) Application.PrintCommunication = False With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "$1:$8" ' 自定义边距 .LeftMargin = Application.InchesToPoints(0.748) .RightMargin = Application.InchesToPoints(0.748) .TopMargin = Application.InchesToPoints(0.984) .BottomMargin = Application.InchesToPoints(0.827) End With Application.PrintCommunication = True With ws ' 设置列宽 .Columns("C:AF").ColumnWidth = 9 End With End Sub ' 通用工作表设置 Private Sub ApplyGeneralSheetSettings(ws As Worksheet) ' 默认设置为横向 With ws.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = False End With ' 替换所有工作表中的"金额单位:?$" On Error Resume Next ws.Cells.Replace What:="金额单位:?$", Replacement:="金额单位:万元", LookAt:=xlPart On Error GoTo 0 End Sub ' 快捷打印宏 Sub QuickPrintAll() ' 直接打印所有配置好的工作表 On Error GoTo PrintError Application.ScreenUpdating = False Dim sheetNames As Variant sheetNames = Array("000", "003", "002", "100", "101", "102", "104", "105", _ "106", "107", "108", "109", "900", "103", "001") Dim wsNames() As String ReDim wsNames(0 To UBound(sheetNames)) Dim i As Long For i = 0 To UBound(sheetNames) wsNames(i) = CStr(sheetNames(i)) Next i ' 选择并打印所有工作表 ThisWorkbook.Sheets(wsNames).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True CleanUp: Application.ScreenUpdating = True Exit Sub PrintError: MsgBox "打印错误: " & Err.Description, vbExclamation Resume CleanUp End Sub ' 恢复默认设置(可选) Sub ResetPrintSettings() Dim ws As Worksheet Dim response As VbMsgBoxResult response = MsgBox("确定要重置所有工作表的打印设置吗?", vbYesNo + vbQuestion, "确认重置") If response = vbYes Then Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws.PageSetup ' 恢复默认设置 .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Zoom = 100 .PrintArea = "" .PrintTitleRows = "" .PrintTitleColumns = "" |
|
看看这个。 日常工作中,有很多时候需要将Excel文件中的内容逐个粘贴到软件/网页中(填表操作),需要不停的复制-粘贴,该软件可以省略打开Excel文件和复制的操作,点击相应的复制按钮即可将所需数据复制到剪切板中。 操作要求: 1.需要在软件同级目录放置以_build.xlsx结尾的excle文件,若无法确定数据是否合适,请将所需数据粘贴到测试表格中运行,表格第一行为标题,标题会被直接读取到按钮标题中; 2.运行后界面“上一条”和“下一条”会逐行显示数据,复制:...按钮会将当前行的数据复制到剪贴板中,使用时直接粘贴即可。 注意: 1.该软件暂时还未适配xls文件,使用时请将文件另存为xlsx格式的文件; 2.软件退出后会将当前读取行数保存到用户目录下,不喜欢乱七八糟配置文件的请另寻高明。 软件及测试文件下载链接: 文件名称:万能表格复制助手 v0.6.zip 百度网盘分享链接: https://pan.baidu.com/s/1FEakoE4WFM5NxODs-UTkPQ 提取码: u3q5 |
|
录个宏最省事了。 感谢各位高手! |
| 围观 |
Powered by Discuz! X3.3
© 2001-2017 Comsenz Inc.