用VBA实现EXCEL表中行标签打印
- 格式：doc
- 大小：35.50 KB
- 文档页数：1
Public Sub 标签打印1()
Application.OnKey "^b", "标签打印"
Dim s, t, I, j, m, n As Integer
Dim MySelect As Range
Set MySelect = Application.InputBox("请输入或者框选标签打印区域:", "指定行或单元格区域", Type:=8)
'如果myselect 是空退出过程,对用户点击输入框的取消按钮后作出判断.
If MySelect Is Nothing Then Exit Sub
I = Range(MySelect.Address).Row '计算首行数i
j = Range(MySelect.Address).Rows.Count + I - 1 ',计算末行数j
s = edRange.Row() - 1 + edRange.Rows.Count '数据区最大行
t = edRange.Column() - 1 + edRange.Columns.Count '数据区最大列
Columns(t + 1).ColumnWidth = 40 '改变工作表列t+1的宽度为20
Rows(s + 1).RowHeight = 20 '改变工作表的行s+1的高度值设置为20
Rows(s + 2).RowHeight = 50 '改变工作表的行s+2的高度值设置为50
Rows(s + 3).RowHeight = 20 '改变工作表的行s+3的高度值设置为20 Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).HorizontalAlignment = xlLeft '水平左对齐
With Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).Characters.Font
.Name = "华文楷体"
.FontStyle = "常规"
.Size = 16
End With
For m = I To j
Cells(s + 1, t + 1).Value = Cells(m, 1).Value '
Cells(s + 2, t + 1).Value = Cells(m, 3).Value '
Cells(s + 3, t + 1).Value = Cells(m, 6).Value '
n = InputBox("当前标签-----" & Cells(m, 1).Value & "----的打印份数")
On Error GoTo 100
Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).PrintOut Copies:=n, Collate:=True
ActiveSheet.Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).Clear '数据清除
100 Next m
'恢复行高列宽为标准值
ActiveSheet.Columns(t + 1).ColumnWidth = StandardWidth
ActiveSheet.Rows(s + 1).RowHeight = StandardHeight
ActiveSheet.Rows(s + 2).RowHeight = StandardHeight
ActiveSheet.Rows(s + 3).RowHeight = StandardHeight
End Sub。
