原本想用python或者QT写一个，刚想动手就发现读取excel的内容api就很麻烦了。该想法直接夭折了。只好祭出VBA。。。

而且excel对于打印票据这种东西，天生有优势。于是边百度边写了几百行代码，感谢microsoft的编辑器，调试很方便（比我用过的python编辑器还强大），再次膜拜微软一把。。

不足：对打开的表格要求很高（需要做格式判断），不够聪明

贴代码，vba的代码看的懂英文单词的基本都知道什么意思,把以下内容复制到宏代码中

下载: vba.txt
  1. Sub printSpecial()
  2. '
  3. ' 功能:打印选中用户工资单
  4. ' 宏由 xningcat 录制，时间: 2010-4-14
  5. '
  6.     Dim wksh As Worksheet
  7.     Set wksh = ActiveWorkbook.Worksheets(1)
  8.     Dim name As String
  9.     name = Selection.Value2
  10.     name = trimName(name)
  11.     Dim fRng As Range
  12.     Set fRng = wksh.Next.UsedRange.Find(what:=name, lookat:=xlWhole)
  13.     Dim cardNo As String
  14.     If Not fRng Is Nothing Then
  15.         cardNo = fRng.Offset(0, 1).Value
  16.         '调整打印的格式
  17.         Dim sh As Worksheet
  18.         Set sh = wksh.Next.Next
  19.         EditSheet3AndPrint(sh,name,cardNo)
  20.     End If
  21. End Sub
  22.  
  23. Sub PrintAll()
  24. '
  25. ' 功能:打印所有用户工资单
  26. ' 宏由 xningcat 录制，时间: 2010-4-14
  27. '
  28.     Dim wksh As Worksheet
  29.     Set wksh = ActiveWorkbook.Worksheets(1)
  30.     lastOne = wksh.Range("A100").End(xlDown).Row
  31.     If lastOne > 100 Then
  32.         lastOne = 99
  33.     End If
  34.     Number = 1
  35.     For i = 1 To lastOne Step 1
  36.         Dim rng As Range
  37.         Set rng = Cells(i, "A")
  38.         If Not rng.Value2 <> Number Then
  39.             '找到了相关数据
  40.             Dim name As String
  41.             name = Cells(i, "B").Value
  42.             name = trimName(name)
  43.             Dim fRng As Range
  44.             Dim cardNo As String
  45.             Set fRng = wksh.Next.UsedRange.Find(what:=name, lookat:=xlWhole)
  46.             If Not fRng Is Nothing Then
  47.                 cardNo = fRng.Offset(0, 1).Value
  48.                 Number = Number + 1
  49.                 '调整打印的格式
  50.                 Dim sh As Worksheet
  51.                 Set sh = wksh.Next.Next
  52.                 EditSheet3AndPrint(sh,name,cardNo)
  53. End If
  54.         End If
  55.     Next
  56. End Sub
  57.  
  58. Private Sub EditSheet3AndPrint(ByVal sh As Worksheet,ByVal name As String,ByVal cardNo As String)
  59. '
  60. ' 功能：生成票据格式并打印
  61. ' 宏由 xningcat 录制，时间: 2010-4-14
  62. '
  63.     With sh
  64.         .Rows.RowHeight = 14.25
  65.         .Cells(5, "A").RowHeight = 21.75
  66.         .Cells(6, "C").Value = name
  67.         .Cells(6, "C").ColumnWidth = 8.38
  68.         .Cells(6, "D").ColumnWidth = 32.52
  69.         .Cells(6, "E").Value = "人民币"
  70.         .Cells(8, "C").Value = cardNo
  71.     End With
  72.     '打印
  73.     sh.PrintOut
  74. End Sub
  75.  
  76. Private Function trimName(ByVal name As String)
  77. '
  78. ' 功能：去掉名字中的空格
  79. ' 宏由 xningcat 录制，时间: 2010-4-14
  80. '
  81.     Dim retStr As String
  82.     For i = 1 To Len(name) Step 1
  83.         s = Mid(name, i, 1)
  84.         If s <> " " Then
  85.             retStr = retStr & s
  86.         End If
  87.     Next
  88.     trimName = retStr
  89. End Function

No related posts.