[已解决]利用VBA批量生成企业询证函，在线等

victory610

各位大神：

       经常需要搞询证函，手工费时费力，用邮件合并解决不了小数点的问题，现请大师门帮忙，能否利用VBA代码实现。谢谢啦。
       详情见附件。

最佳答案

月排行榜 / 总排行榜

fffox

2014-7-10 09:05

如果不需要按客户生成工作表，而是直接打印，则改为：

1. Sub test()
   
2.     Dim arr, i%
   
3.     Application.DisplayAlerts = False
   
4.     arr = Sheets("函证信息").Range("a1").CurrentRegion.Value
   
5.     For i = 2 To UBound(arr)
   
6.         Worksheets("企业询证函模板 ").Copy After:=Worksheets(Worksheets.Count)
   
7.         With Worksheets(Worksheets.Count)
   
8.             '.Name = arr(i, 2)
   
9.             .Range("h3") = "编号：" & arr(i, 1)
   
10.             .Range("a5") = arr(i, 2)
    
11.             .Range("c12") = arr(i, 3)
    
12.             .PrintOut 1, 1
    
13.             .Delete
    
14.         End With
    
15.     Next
    
16.     Application.DisplayAlerts = True
    
17. End Sub

复制代码

（代码设定只打印第一页）

跳转到最佳答案楼层

蝶·舞

邮件合并是可以解决小数点问题的，用域代码

victory610

我还是想用VBA代码。

fffox

victory610 发表于 2014-7-9 20:00
我还是想用VBA代码。

根据函证信息表内容，按客户生成工作表：

1. Sub test()
   
2.     Dim arr, i%
   
3.     Application.DisplayAlerts = False
   
4.     arr = Sheets("函证信息").Range("a1").CurrentRegion.Value
   
5.     For i = 2 To UBound(arr)
   
6.         Worksheets("企业询证函模板 ").Copy After:=Worksheets(Worksheets.Count)
   
7.         With Worksheets(Worksheets.Count)
   
8.             .Name = arr(i, 2)
   
9.             .Range("h3") = "编号：" & arr(i, 1)
   
10.             .Range("a5") = arr(i, 2)
    
11.             .Range("c12") = arr(i, 3)
    
12.         End With
    
13.     Next
    
14.     Application.DisplayAlerts = True
    
15. End Sub

复制代码

fffox

如果不需要按客户生成工作表，而是直接打印，则改为：

1. Sub test()
   
2.     Dim arr, i%
   
3.     Application.DisplayAlerts = False
   
4.     arr = Sheets("函证信息").Range("a1").CurrentRegion.Value
   
5.     For i = 2 To UBound(arr)
   
6.         Worksheets("企业询证函模板 ").Copy After:=Worksheets(Worksheets.Count)
   
7.         With Worksheets(Worksheets.Count)
   
8.             '.Name = arr(i, 2)
   
9.             .Range("h3") = "编号：" & arr(i, 1)
   
10.             .Range("a5") = arr(i, 2)
    
11.             .Range("c12") = arr(i, 3)
    
12.             .PrintOut 1, 1
    
13.             .Delete
    
14.         End With
    
15.     Next
    
16.     Application.DisplayAlerts = True
    
17. End Sub

复制代码

（代码设定只打印第一页）

victory610

感谢fffox的鼎力帮助，代码运行得很快，很满意。

hhxq001

fffox 发表于 2014-7-10 08:59
根据函证信息表内容，按客户生成工作表：

我如果想把所有的客户表放在一个工作表中怎么写代码呢？也就是不是一个客户一个工作表。

hhxq001

社会养老保险登记表--批量生成个人表0712.zip (19.11 KB, 下载次数: 102)

2014-7-12 18:48 上传

点击文件名下载附件

excel菜鸟求助

fffox 发表于 2014-7-10 08:59
根据函证信息表内容，按客户生成工作表：

大神急求助企业询证函我把你的编码填进去没反应，该怎么操作啊？方便给个联系方式么？