在Excel工作簿复制内容格式以及打印的参数设置

在Excel工作簿复制内容格式以及打印的参数设置
作者：梁小铭当然手工也可实现 ，但使用VBA可批量自动化实现这个工作，如果这个工作经常要做的话，用代码可以大大提高效率
SubCopyFormat(BytNumAsByte) '复制内容格式以及打印的参数设置
DimshtAsWorksheet,newshtAsWorksheet,wkbAsWorkbook,newbookAsWorkbook
OnErrorGoToerrline
Application.Visible=False '隐藏主程序
Setwkb=ActiveWorkbook '当前活动工作簿
Setnewbook=Workbooks.Add '创建工作簿
'路径和保存的工作簿名称自行设置
newbook.SaveAsFilename:=wkb.Path&"\"&"复制.xlsm",FileFormat:=xlOpenXMLWorkbookMacroEnabled
'BytNum参数的值是0的话则复制当前区域的内容和格式
'BytNum参数的值是1的话则复制整表
IfBytNum=0Then
ForEachshtInwkb.Worksheets
Setnewsht=newbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
'newsht.Name="1" '新建的工作表自己自行取名字
'先复制当前区域，整行复制才能把行高一同复制过去
sht.Range("a1").CurrentRegion.EntireRow.Copynewsht.Range("a1")
newsht.Activate '必须先激活工作表才能进行列宽粘帖
sht.Range("a1").CurrentRegion.Copy '复制当前区域的内容和格式
'选择性粘帖列宽格式
newsht.Range("a1").CurrentRegion.PasteSpecialPaste:=xlPasteColumnWidths
CallPageSetup(newsht,sht) '设置打印参数（页边距等）
Next
ElseIfBytNum=1Then
ForEachshtInwkb.Worksheets
sht.CopyAfter:=newbook.Worksheets(Worksheets.Count) '复制整表到新的工作簿里
Setnewsht=newbook.ActiveSheet '把新复制的工作表赋值给变量newsht
'newsht.Name="1" '新建的工作表自己自行取名字
CallPageSetup(newsht,sht) '设置打印参数（页边距等）
Next
EndIf
errline:
Application.Visible=True '恢复显示主程序
EndSub
FunctionPageSetup(NewPageShtAsWorksheet,OldPageShtAsWorksheet) '设置打印参数（页边距等）
WithNewPageSht
.PageSetup.Orientation=xlLandscape '横向
.PageSetup.Orientation=OldPageSht.PageSetup.Orientation '打印方向
.PageSetup.LeftMargin=OldPageSht.PageSetup.LeftMargin '左边距
.PageSetup.RightMargin=OldPageSht.PageSetup.RightMargin '右边距
.PageSetup.TopMargin=OldPageSht.PageSetup.TopMargin '上边距
.PageSetup.BottomMargin=OldPageSht.PageSetup.BottomMargin '下边距
.PageSetup.HeaderMargin=OldPageSht.PageSetup.HeaderMargin '页眉
.PageSetup.FooterMargin=OldPageSht.PageSetup.FooterMargin '页角
.PageSetup.PrintTitleColumns=OldPageSht.PageSetup.PrintTitleColumns
'.PageSetup.PrintTitleRows="$1:$5" '顶端标题行
'.ProtectPassword:="ljc",DrawingObjects:=True,Contents:=True,Scenarios:=True
EndWith
EndFunction
Subtext() '测试代码
RemBytNum参数的值是0的话则复制当前区域的内容和格式
RemBytNum参数的值是1的话则复制整表
CallCopyFormat(1)
EndSub
上次写的复制区域行高，列宽，以及打印区域设置