- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 错误提示：被呼叫方拒绝接收呼叫 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=80268)
-- 发布时间：2016/1/19 16:55:00
-- 错误提示：被呼叫方拒绝接收呼叫
以下代码做为一个自定义函数，执行的时候报错：被呼叫方拒绝接收呼叫见截图
此主题相关图片如下：333337.jpg
Dim path As String = args(0)
Dim excelApp As New MSExcel.Application
excelApp.visible =True
excelApp.DisplayAlerts=False
Dim wordApp As New MSWord.Application
wordapp.Visible = True
Dim Doc As MSWord.Document
Dim DocRange As MSWord.Range
Doc = wordApp.Documents.Add()
Docrange = Doc.range()
Dim filename As String = path & "\\统计.docx"
For Each file As String In FileSys.GetFiles(path)
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
Dim Wb As MSExcel.WorkBook=excelApp.WorkBooks.open(file)
For k As Integer = 1 To Wb.WorkSheets.Count \'//多个sheet的处理
Dim Ws As MSExcel.WorkSheet=Wb.WorkSheets(k)
Dim Rg As MSExcel.Range = Ws.UsedRange
If Rg.Columns.Count <> 16384 Then
Rg.copy()
DocRange.Paste
Docrange.Collapse(0)
Docrange.Insertparagraphafter()
Docrange.Collapse(0)
Else
Dim txt2 As WinForm.TextBox = Forms("EXCEL导WORD").Controls("TextBox6")
txt2.text = file & vbcrlf & txt2.text & vbcrlf
End If
Next
wb.close()
Dim txt1 As WinForm.TextBox = Forms("EXCEL导WORD").Controls("TextBox3")
txt1.text = file & vbcrlf & txt1.text & vbcrlf
Application.DoEvents()
FileCount=FileCount+1
End If
Next
For Each p As String In FileSys.GetDirectories(path)
Functions.Execute("EXCEL导WORD函数", p)
Next
Doc.saveas(filename)
Doc.close()
excelapp.quit()
wordapp.quit()
Dim lbl As WinForm.Label = Forms("EXCEL导WORD").Controls("Label6")
lbl.Text="共处理" & FileCount & "个文件"
-- 发布时间：2016/1/19 16:59:00
--
试试
Dim Ws As MSExcel.WorkSheet=Wb.WorkSheets(k)
ws.Select
Dim Rg As MSExcel.Range = Ws.UsedRange
不行，就上传具体例子测试。
-- 发布时间：2016/1/20 11:35:00
--
上传例子：程序偶尔会执行正确，偶尔就会报错，我找不到规律。麻烦老师给看看：
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:test.rar |
[此贴子已经被作者于2016/1/20 11:34:54编辑过]
-- 发布时间：2016/1/20 11:38:00
--
测试了，不报错。肯定是你MS Office安装有问题，卸载重装完整版的。
-- 发布时间：2016/1/20 14:39:00
--
麻烦您反复测试一下，多点几次。我这里安装的是OFFICE2016正版。
-- 发布时间：2016/1/20 14:39:00
--
只有多点几次他就会报那个错，好像EXCEL中的SHEET一多就出错。
-- 发布时间：2016/1/20 14:44:00
--
点多少次我也没测试出错。
-- 发布时间：2016/1/20 14:59:00
--
看论坛的贴子好像在其中一行加MessageBox.show()中断一下就不报错，是不是程序没有执行完?
For k As Integer = 1 To Wb.WorkSheets.Count \'//多个sheet的处理
Dim Ws As MSExcel.WorkSheet=Wb.WorkSheets(k)
Dim Rg As MSExcel.Range = Ws.UsedRange
If Rg.Columns.Count <> 16384 Then
Rg.copy()
MessageBox.show("提示信息") \'在粘贴之前加了一个中断就不会报错。
DocRange.Paste
Docrange.Collapse(0)
Docrange.Insertparagraphafter()
Docrange.Collapse(0)
-- 发布时间：2016/1/20 15:26:00
--
Dim Ws As MSExcel.WorkSheet=Wb.WorkSheets(k)
ws.Select
Dim Rg As MSExcel.Range = Ws.UsedRange
Rg.Select
改一下，如果还报错。说明，就是你MS Office的问题