标签（宏）——最新、实用

413191246se

* 前两天，单位有人让制作几个标签，结果，用通用模板中的“标签”宏制作后，出入很大，不实用，所以这两天考虑重新制作这个宏，其实，这个宏多数是录制宏的结合，编的很少，但感觉很实用了，起码本单位以后再用就方便多了。
* 请注意：请把要制作标签的文字放在一个表格中，且该表格要仅有一列！这样让《标签宏》处理它，纵向/横向就都好办了。
* 应用此宏后，纵向标签可以设置字符缩放为120%或150%让字体变得修长些；横向标签可以设置为90%让字体变得修长些；同时，字体没有变化，请自行选用中文字体。
* 此宏其实还可以再精简些，但为了保持完整性，并继续观察是否好用（如果某条语句出错，请在宏前面加上 on error resume next）。——比原来的此宏减少一半代码。

1. Sub 标签()
   
2.     If Selection.Information(wdWithInTable) = False Then MsgBox "请将光标放在标签数据源表格中！", vbOKOnly + vbCritical, "标签": End
   
3.     If Selection.Tables(1).Columns.Count <> 1 Then MsgBox "标签数据源表格仅允许有一列！", vbOKOnly + vbCritical, "标签": End
   
4.     Dim i As String
   
5.     i = MsgBox("是：纵向标签（书脊）    否：横向标签（封面）    取消：放弃", vbYesNoCancel + vbExclamation, "标签")
   
6.     If i = vbCancel Then End
   
7.     Selection.Tables(1).Range.Copy
   
8.     Documents.Add.Content.Paste
   
9.     Selection.Tables(1).Select
   
10.     Selection.Font.Bold = True
    
11.     Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
12.     Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
13.     With ActiveDocument.PageSetup
    
14.         .TopMargin = CentimetersToPoints(2)
    
15.         .BottomMargin = CentimetersToPoints(2)
    
16.         .LeftMargin = CentimetersToPoints(1)
    
17.         .RightMargin = CentimetersToPoints(1)
    
18.     End With
    
19.     If i = vbYes Then '纵向标签
    
20.         ActiveDocument.PageSetup.Orientation = wdOrientLandscape
    
21.         Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
    
22.         Selection.Rows.HeightRule = wdRowHeightExactly
    
23.         Selection.Rows.Height = CentimetersToPoints(3)
    
24.         Selection.Orientation = wdTextOrientationHorizontalRotatedFarEast
    
25.         Selection.ParagraphFormat.Alignment = wdAlignParagraphDistribute
    
26.         Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    
27.         Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
    
28.         Selection.Font.Size = 48
    
29.     ElseIf i = vbNo Then '横向标签
    
30.         Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    
31.         Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    
32.         ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak Type:=wdSectionBreakContinuous
    
33.         With Selection.PageSetup.TextColumns
    
34.             .SetCount NumColumns:=2
    
35.             .EvenlySpaced = True
    
36.             .LineBetween = False
    
37.             .Width = CentimetersToPoints(8.76)
    
38.             .Spacing = CentimetersToPoints(1.48)
    
39.         End With
    
40.         Selection.Rows.HeightRule = wdRowHeightExactly
    
41.         Selection.Rows.Height = CentimetersToPoints(5)
    
42.         Selection.Font.Size = 60
    
43.     End If
    
44.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
    
45.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
    
46. End Sub

复制代码

标签宏数据源--示例文件 下载： 标签数据源（示例）.rar (3.73 KB, 下载次数: 304)

2013-10-29 21:07 上传

点击文件名下载附件

fdsa100

谢谢楼主分享

413191246se

补：
* 纵向标签：制作完毕后，可以显示表格虚框，拖拽表格左右边框线，让表格变大或变小以此改变表格中标签的长度及文字之间的距离。
* 本次标签采用表格实线框，请各位朋友使用此宏打印后，用剪刀或格尺、刀片沿着表格线裁剪即可。
* 有不同使用意见或建议的朋友，请跟帖提出来，大家共同改进、提高。水平较低，难免有错漏之处，请多多包涵！谢谢！

413191246se

* 原宏代码共 112 行，现在共 44 行，减少了一半多，但是比过去更为实用、精简（其实还可以再精简几行）。

20083456

谢谢楼主分享

2337359709

菜鸟表示看不懂

cqpp01

可以自动保存在同一目录里吗？

菜菜行者

标签？具体是怎么用途？不懂！

413191246se

菜菜，一楼说的明白，试试就知道了！

zzwq2008

试试就知道了！