[已解决]改成文本控件

yjwdjfqb

VBA批量打印人员信息表－改成文本控件

想把这个改成文本控件形式的，请老师们帮帮忙，谢谢大家了！

VBA批量打印人员信息表－改成文本控件.rar (45.31 KB, 下载次数: 14)

2014-4-12 12:25 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-13 18:50

1. Sub 批量打印人员信息表()
   
2. Dim rng As Range, c As Range, h&
   
3. On Error Resume Next
   
4. Set rng = Application.InputBox("请选择需要打印的人员" & vbCrLf & vbCrLf & "可按CTRL键选择不连续的人员", "提示", , Type:=8)
   
5. If rng Is Nothing Then Exit Sub
   
6. If MsgBox("将有" & rng.Count & "条数据被打印，请确定是否打印!", vbYesNo + vbInformation, "系统提示") = vbNo Then Exit Sub
   
7. With Sheets("Template")
   
8.     For Each c In rng
   
9.         h = c.Row
   
10.         .Shapes("TXTc").DrawingObject.Caption = Cells(h, "e")
    
11.         '其他类推
    
12.         .[a1:h25].PrintOut
    
13.     Next
    
14. End With
    
15. MsgBox "操作完毕！", vbInformation + vbOKOnly, "提示"
    
16. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

工作表界面输入多方便，干嘛要用文本框？

1. Sub 批量打印人员信息表()
   
2. Dim rng As Range, c As Range
   
3. On Error Resume Next
   
4. Set rng = Application.InputBox("请选择需要打印的人员" & vbCrLf & vbCrLf & "可按CTRL键选择不连续的人员", "提示", , Type:=8)
   
5. If rng Is Nothing Then Exit Sub
   
6. If MsgBox("将有" & rng.Count & "条数据被打印，请确定是否打印!", vbYesNo + vbInformation, "系统提示") = vbNo Then Exit Sub
   
7. For Each c In rng
   
8.     Sheets("Template").Activate
   
9.     ActiveSheet.Shapes("TXTa").Select
   
10.     Selection.Text = c
    
11. '其他类推
    
12.     ActiveSheet.UsedRange.PrintOut
    
13. Next
    
14. MsgBox "操作完毕！", vbInformation + vbOKOnly, "提示"
    
15. Sheets("Data").Activate
    
16. End Sub
    

复制代码

yjwdjfqb

dsmch 发表于 2014-4-12 13:02
工作表界面输入多方便，干嘛要用文本框？

谢谢老师了，但打印出来全是空白页呀！

万分的感谢老师！

yjwdjfqb

dsmch 发表于 2014-4-12 13:02
工作表界面输入多方便，干嘛要用文本框？

老师，再请教你下，

    .Shapes("TXTb").DrawingObject.Caption = c.offset(0, 3) '向右偏移3格      

    .Shapes("TXTc").DrawingObject.Caption = c.offset(0, 5)

    .Shapes("TXTd").DrawingObject.Caption = c.offset(0, 8)

问题：
    .Shapes("TXTc").DrawingObject.Caption = c.offset(0, 5)    '向右偏移5格      ，这不用向右偏移3格的表示方法 ，想改成       就直接设置成      E列，  也就是   C行对应的E列数据

dsmch

1. Sub 批量打印人员信息表()
   
2. Dim rng As Range, c As Range, h&
   
3. On Error Resume Next
   
4. Set rng = Application.InputBox("请选择需要打印的人员" & vbCrLf & vbCrLf & "可按CTRL键选择不连续的人员", "提示", , Type:=8)
   
5. If rng Is Nothing Then Exit Sub
   
6. If MsgBox("将有" & rng.Count & "条数据被打印，请确定是否打印!", vbYesNo + vbInformation, "系统提示") = vbNo Then Exit Sub
   
7. With Sheets("Template")
   
8.     For Each c In rng
   
9.         h = c.Row
   
10.         .Shapes("TXTc").DrawingObject.Caption = Cells(h, "e")
    
11.         '其他类推
    
12.         .[a1:h25].PrintOut
    
13.     Next
    
14. End With
    
15. MsgBox "操作完毕！", vbInformation + vbOKOnly, "提示"
    
16. End Sub
    

复制代码

yjwdjfqb

dsmch 发表于 2014-4-13 18:50

        .Shapes("TXTc").DrawingObject.Caption = Cells(h, "h")


得到的日期，格式不对，我在数据表中，设置了日期格式，

得到的  不是日期格式，这个怎么解决 呀朋友，麻烦你了！

yjwdjfqb

dsmch 发表于 2014-4-13 18:50

朋友你好，感谢了


CDate(Cells(h, "h"))或者 Format(Cells(h, "h"), "yyyy-mm-dd")

CDate(Cells(h, "h"))  这样可以，但显示的格式是    5/1/2007  这样的，，想显示成    2007-01-05  可以不


Format(Cells(h, "h"), "yyyy-mm-dd")   这样不行，显示工程没有找到