[已解决]求助为什么提取数据时找不到数据源会出错呢。谢谢

qinhuan66

求助为什么提取数据时找不到数据源会出错呢。谢谢
生成准考证.rar (201.85 KB, 下载次数: 31)

2013-7-24 15:06 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-7-24 18:29

1. Private Sub CommandButton13_Click()
   
2.    Unload Me
   
3. End Sub
   
4. 
   
5. Private Sub CommandButton4_Click()
   
6.     Dim Word对象 As New Word.Application, shp As Object
   
7.     Dim 当前路径 As String, 导出文件名 As String, 导出路径文件名 As String, 判断
   
8.     Dim k As Long, l As Long, i As Long, j As Long
   
9.     Dim strPhoto As String
   
10.     Dim B As Long, C As Long
    
11.     Dim btn As Long
    
12.     strPhoto = ThisWorkbook.Path & "\相片"
    
13.     当前路径 = ThisWorkbook.Path & "\准考证发放包"
    
14. 
    
15.     最后行号 = Sheets("数据库").Range("B1002").End(xlUp).Row
    
16. 
    
17.     B = Application.InputBox("请输入数据开始行,不能小于3行。", Title:="提示", Type:=1)
    
18.     C = Application.InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示", Type:=1)
    
19. 
    
20.     If B <= 0 Or C <= 0 Then
    
21.         MsgBox "输入的行号有小于等于0或者取消的情况，结束", vbCritical
    
22.         Exit Sub
    
23.     End If
    
24. 
    
25.     If B < 3 Then
    
26.         MsgBox "数据开始行的行号不符合要求，结束", vbCritical
    
27.         Exit Sub
    
28.     End If
    
29. 
    
30.     If C > 最后行号 Then
    
31.         MsgBox "数据结束行的行号不符合要求，结束", vbCritical
    
32.         Exit Sub
    
33.     End If
    
34. 
    
35.     If C < B Then
    
36.         MsgBox "数据结束行的行号不得小于起始行的行号，结束", vbCritical
    
37.         Exit Sub
    
38.     End If
    
39. 
    
40.     'b = InputBox("请输入数据开始行,不能小于3行。", "提示")
    
41.     'C = InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示")
    
42. 
    
43. 
    
44.     判断 = 0
    
45.     导出文件名 = "准考证（参加本次考试全部人员）.doc"
    
46.     导出路径文件名 = 当前路径 & "" & 导出文件名
    
47.     FileCopy 当前路径 & "\准考证打印模板.doc", 导出路径文件名
    
48.     With Word对象
    
49. 
    
50.         .Documents.Open 导出路径文件名
    
51.         .Application.ScreenUpdating = False
    
52.         .Application.DisplayAlerts = False
    
53.         '.Visible = True
    
54.         .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument    '设置位置在正文
    
55.         .Selection.WholeStory    '全选
    
56.         .Selection.Copy    '复制
    
57.         If 最后行号 > 3 Then
    
58.             For i = 3 To C - 1    '复制页
    
59.                 .Selection.EndKey Unit:=wdStory    '光标置于文件尾
    
60.                 .Selection.InsertBreak Type:=wdPageBreak    '分页
    
61.                 .Selection.PasteAndFormat (wdPasteDefault)    '粘贴
    
62.             Next i
    
63.             Me.Label1.Caption = "正在生成第 " & i & "行记录"
    
64.         End If
    
65.         Set shp = .ActiveDocument.Shapes
    
66. 
    
67.         For i = B To C
    
68.             Me.Label1.Caption = "正在生成第 " & i - B + 1 & " 页数据"
    
69.             For j = 1 To 10    '填写文字数据
    
70.                 Str1 = "数据" & Format(j, "000")
    
71.                 Str2 = Sheets("数据库").Cells(i, j)
    
72.                 .Selection.HomeKey Unit:=wdStory    '光标置于文件首
    
73.                 If .Selection.Find.Execute(Str1) Then    '查找到指定字符串
    
74.                     .Selection.Font.Color = wdColorAutomatic    '字符为自动颜色
    
75.                     .Selection.Text = Str2    '替换字符串
    
76.                 End If
    
77.             Next j
    
78.             For k = l + 1 To shp.Count
    
79.                 If shp(k).Type = 17 Then Exit For
    
80.             Next
    
81.             l = k
    
82.             On Error GoTo ErrorHandler
    
83.             shp(k).Fill.UserPicture strPhoto & Sheets("数据库").Cells(i, 1) & ".jpg"
    
84.             Err.Clear
    
85.             On Error GoTo 0
    
86.         Next i
    
87.     End With
    
88.     Word对象.Documents.Save
    
89.     Word对象.Quit
    
90.     Set Word对象 = Nothing
    
91.     If 判断 = 0 Then
    
92.         i = MsgBox("朋友你需要的准考证已生成完毕，现已保存到“" & 导出路径文件名 & "”！如需要帮助请QQ联系695360052", 0 + 48 + 256 + 0, "提示："): Unload 登录操作界面
    
93.     End If
    
94.     Exit Sub
    
95. ErrorHandler:
    
96. 
    
97.     'btn = MsgBox(prompt:="错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, Buttons:=vbInformation + vbAbort + vbIgnore) = vbRetry
    
98.     btn = MsgBox("错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, vbAbortRetryIgnore)
    
99.     Select Case btn
    
100.         Case vbRetry
     
101.             Resume
     
102.         Case vbIgnore
     
103.             Resume Next
     
104.         Case vbAbort
     
105.             With Word对象
     
106.                 .ActiveDocument.Close False
     
107.                 .Quit
     
108.             End With
     
109.             Set Word对象 = Nothing
     
110.             MsgBox "结束"
     
111.             Me.Label1.Caption = ""
     
112.     End Select
     
113. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

取消是什么意思？
结束还是？

qinhuan66

hwc2ycy 发表于 2013-7-24 17:45
取消是什么意思？
结束还是？

老师是的就是结束的意思

hwc2ycy

1. Private Sub CommandButton13_Click()
   
2.    Unload Me
   
3. End Sub
   
4. 
   
5. Private Sub CommandButton4_Click()
   
6.     Dim Word对象 As New Word.Application, shp As Object
   
7.     Dim 当前路径 As String, 导出文件名 As String, 导出路径文件名 As String, 判断
   
8.     Dim k As Long, l As Long, i As Long, j As Long
   
9.     Dim strPhoto As String
   
10.     Dim B As Long, C As Long
    
11.     Dim btn As Long
    
12.     strPhoto = ThisWorkbook.Path & "\相片"
    
13.     当前路径 = ThisWorkbook.Path & "\准考证发放包"
    
14. 
    
15.     最后行号 = Sheets("数据库").Range("B1002").End(xlUp).Row
    
16. 
    
17.     B = Application.InputBox("请输入数据开始行,不能小于3行。", Title:="提示", Type:=1)
    
18.     C = Application.InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示", Type:=1)
    
19. 
    
20.     If B <= 0 Or C <= 0 Then
    
21.         MsgBox "输入的行号有小于等于0或者取消的情况，结束", vbCritical
    
22.         Exit Sub
    
23.     End If
    
24. 
    
25.     If B < 3 Then
    
26.         MsgBox "数据开始行的行号不符合要求，结束", vbCritical
    
27.         Exit Sub
    
28.     End If
    
29. 
    
30.     If C > 最后行号 Then
    
31.         MsgBox "数据结束行的行号不符合要求，结束", vbCritical
    
32.         Exit Sub
    
33.     End If
    
34. 
    
35.     If C < B Then
    
36.         MsgBox "数据结束行的行号不得小于起始行的行号，结束", vbCritical
    
37.         Exit Sub
    
38.     End If
    
39. 
    
40.     'b = InputBox("请输入数据开始行,不能小于3行。", "提示")
    
41.     'C = InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示")
    
42. 
    
43. 
    
44.     判断 = 0
    
45.     导出文件名 = "准考证（参加本次考试全部人员）.doc"
    
46.     导出路径文件名 = 当前路径 & "" & 导出文件名
    
47.     FileCopy 当前路径 & "\准考证打印模板.doc", 导出路径文件名
    
48.     With Word对象
    
49. 
    
50.         .Documents.Open 导出路径文件名
    
51.         .Application.ScreenUpdating = False
    
52.         .Application.DisplayAlerts = False
    
53.         '.Visible = True
    
54.         .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument    '设置位置在正文
    
55.         .Selection.WholeStory    '全选
    
56.         .Selection.Copy    '复制
    
57.         If 最后行号 > 3 Then
    
58.             For i = 3 To C - 1    '复制页
    
59.                 .Selection.EndKey Unit:=wdStory    '光标置于文件尾
    
60.                 .Selection.InsertBreak Type:=wdPageBreak    '分页
    
61.                 .Selection.PasteAndFormat (wdPasteDefault)    '粘贴
    
62.             Next i
    
63.             Me.Label1.Caption = "正在生成第 " & i & "行记录"
    
64.         End If
    
65.         Set shp = .ActiveDocument.Shapes
    
66. 
    
67.         For i = B To C
    
68.             Me.Label1.Caption = "正在生成第 " & i - B + 1 & " 页数据"
    
69.             For j = 1 To 10    '填写文字数据
    
70.                 Str1 = "数据" & Format(j, "000")
    
71.                 Str2 = Sheets("数据库").Cells(i, j)
    
72.                 .Selection.HomeKey Unit:=wdStory    '光标置于文件首
    
73.                 If .Selection.Find.Execute(Str1) Then    '查找到指定字符串
    
74.                     .Selection.Font.Color = wdColorAutomatic    '字符为自动颜色
    
75.                     .Selection.Text = Str2    '替换字符串
    
76.                 End If
    
77.             Next j
    
78.             For k = l + 1 To shp.Count
    
79.                 If shp(k).Type = 17 Then Exit For
    
80.             Next
    
81.             l = k
    
82.             On Error GoTo ErrorHandler
    
83.             shp(k).Fill.UserPicture strPhoto & Sheets("数据库").Cells(i, 1) & ".jpg"
    
84.             Err.Clear
    
85.             On Error GoTo 0
    
86.         Next i
    
87.     End With
    
88.     Word对象.Documents.Save
    
89.     Word对象.Quit
    
90.     Set Word对象 = Nothing
    
91.     If 判断 = 0 Then
    
92.         i = MsgBox("朋友你需要的准考证已生成完毕，现已保存到“" & 导出路径文件名 & "”！如需要帮助请QQ联系695360052", 0 + 48 + 256 + 0, "提示："): Unload 登录操作界面
    
93.     End If
    
94.     Exit Sub
    
95. ErrorHandler:
    
96. 
    
97.     'btn = MsgBox(prompt:="错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, Buttons:=vbInformation + vbAbort + vbIgnore) = vbRetry
    
98.     btn = MsgBox("错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, vbAbortRetryIgnore)
    
99.     Select Case btn
    
100.         Case vbRetry
     
101.             Resume
     
102.         Case vbIgnore
     
103.             Resume Next
     
104.         Case vbAbort
     
105.             With Word对象
     
106.                 .ActiveDocument.Close False
     
107.                 .Quit
     
108.             End With
     
109.             Set Word对象 = Nothing
     
110.             MsgBox "结束"
     
111.             Me.Label1.Caption = ""
     
112.     End Select
     
113. End Sub

复制代码

hwc2ycy

其实用模板方法还比较好，省得去COPY，有时WORD对象没有退出的话，就会报错了。

hwc2ycy

用模板的方法建立WORD文件。

1. Private Sub CommandButton4_Click()
   
2.     Dim Word对象 As New Word.Application, shp As Object
   
3.     Dim 当前路径 As String, 导出文件名 As String, 导出路径文件名 As String, 判断
   
4.     Dim k As Long, l As Long, i As Long, j As Long
   
5.     Dim strPhoto As String
   
6.     Dim B As Long, C As Long
   
7.     Dim btn As Long
   
8.     strPhoto = ThisWorkbook.Path & "\相片"
   
9.     当前路径 = ThisWorkbook.Path & "\准考证发放包"
   
10. 
    
11.     最后行号 = Sheets("数据库").Range("B1002").End(xlUp).Row
    
12. 
    
13.     B = Application.InputBox("请输入数据开始行,不能小于3行。", Title:="提示", Type:=1)
    
14.     C = Application.InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示", Type:=1)
    
15. 
    
16.     If B <= 0 Or C <= 0 Then
    
17.         MsgBox "输入的行号有小于等于0或者取消的情况，结束", vbCritical
    
18.         Exit Sub
    
19.     End If
    
20. 
    
21.     If B < 3 Then
    
22.         MsgBox "数据开始行的行号不符合要求，结束", vbCritical
    
23.         Exit Sub
    
24.     End If
    
25. 
    
26.     If C > 最后行号 Then
    
27.         MsgBox "数据结束行的行号不符合要求，结束", vbCritical
    
28.         Exit Sub
    
29.     End If
    
30. 
    
31.     If C < B Then
    
32.         MsgBox "数据结束行的行号不得小于起始行的行号，结束", vbCritical
    
33.         Exit Sub
    
34.     End If
    
35. 
    
36.     'b = InputBox("请输入数据开始行,不能小于3行。", "提示")
    
37.     'C = InputBox("请输入数据结束行，不能大于" & 最后行号 & " 行。", "提示")
    
38. 
    
39. 
    
40.     判断 = 0
    
41.     导出文件名 = "准考证（参加本次考试全部人员）.doc"
    
42.     导出路径文件名 = 当前路径 & "" & 导出文件名
    
43. 
    
44.     'FileCopy 当前路径 & "\准考证打印模板.doc", 导出路径文件名
    
45.     With Word对象
    
46. 
    
47.         '.Documents.Open 导出路径文件名
    
48.         .Documents.Add Template:=当前路径 & "\准考证打印模板.doc"
    
49.         .Application.ScreenUpdating = False
    
50.         .Application.DisplayAlerts = False
    
51.         '.Visible = True
    
52.         .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument    '设置位置在正文
    
53.         .Selection.WholeStory    '全选
    
54.         .Selection.Copy    '复制
    
55.         If 最后行号 > 3 Then
    
56.             For i = 3 To C - 1    '复制页
    
57.                 .Selection.EndKey Unit:=wdStory    '光标置于文件尾
    
58.                 .Selection.InsertBreak Type:=wdPageBreak    '分页
    
59.                 .Selection.PasteAndFormat (wdPasteDefault)    '粘贴
    
60.             Next i
    
61.             Me.Label1.Caption = "正在生成第 " & i & "行记录"
    
62.         End If
    
63.         Set shp = .ActiveDocument.Shapes
    
64. 
    
65.         For i = B To C
    
66.             Me.Label1.Caption = "正在生成第 " & i - B + 1 & " 页数据"
    
67.             For j = 1 To 10    '填写文字数据
    
68.                 Str1 = "数据" & Format(j, "000")
    
69.                 Str2 = Sheets("数据库").Cells(i, j)
    
70.                 .Selection.HomeKey Unit:=wdStory    '光标置于文件首
    
71.                 If .Selection.Find.Execute(Str1) Then    '查找到指定字符串
    
72.                     .Selection.Font.Color = wdColorAutomatic    '字符为自动颜色
    
73.                     .Selection.Text = Str2    '替换字符串
    
74.                 End If
    
75.             Next j
    
76.             For k = l + 1 To shp.Count
    
77.                 If shp(k).Type = 17 Then Exit For
    
78.             Next
    
79.             l = k
    
80.             On Error GoTo ErrorHandler
    
81.             shp(k).Fill.UserPicture strPhoto & Sheets("数据库").Cells(i, 1) & ".jpg"
    
82.             Err.Clear
    
83.             On Error GoTo 0
    
84.         Next i
    
85. 
    
86.         .ActiveDocument.SaveAs Filename:=当前路径 & "\准考证打印模板.doc"
    
87.         .Quit
    
88.     End With
    
89.     Set Word对象 = Nothing
    
90.     If 判断 = 0 Then
    
91.         i = MsgBox("朋友你需要的准考证已生成完毕，现已保存到“" & 导出路径文件名 & "”！如需要帮助请QQ联系695360052", 0 + 48 + 256 + 0, "提示："): Unload 登录操作界面
    
92.     End If
    
93.     Exit Sub
    
94. 
    
95. ErrorHandler:
    
96.     'btn = MsgBox(prompt:="错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, Buttons:=vbInformation + vbAbort + vbIgnore) = vbRetry
    
97.     btn = MsgBox("错误信息号码:" & Err.Number & vbCrLf & "错误信息描述：" & Err.Description & vbCrLf, vbAbortRetryIgnore)
    
98.     Select Case btn
    
99.         Case vbRetry
    
100.             Resume
     
101.         Case vbIgnore
     
102.             Resume Next
     
103.         Case vbAbort
     
104.             With Word对象
     
105.                 .ActiveDocument.Close False
     
106.                 .Quit
     
107.             End With
     
108.             Set Word对象 = Nothing
     
109.             MsgBox "结束"
     
110.             Me.Label1.Caption = ""
     
111.     End Select
     
112. End Sub

复制代码

qinhuan66

hwc2ycy 发表于 2013-7-24 18:29

老师是否能帮手改一手导出的准考证以生成多少人作文件名（例如从3行开始至12行结束的话：生成为“准考证（编号1--编号10）、如果从15行开始到25行的话就生成为”准考证（编号13--编号23）谢谢
如下图

hwc2ycy

qinhuan66 发表于 2013-7-24 19:48
老师是否能帮手改一手导出的准考证以生成多少人作文件名（例如从3行开始至12行结束的话：生成为“准考证（ ...

15-25变成13-23？有什么规律没？

qinhuan66

hwc2ycy 发表于 2013-7-24 21:48
15-25变成13-23？有什么规律没？

没有？我的意思是有时人太多。分段生成准考证。谢谢