把发文稿纸中的内容提取到发文登记簿中？

4me · 发表于 2009-11-2 14:43

是把发文稿.doc和发文登记簿.xls放一起。发文登记簿里看到的是导入的结果。

[ 本帖最后由 4me 于 2009-11-2 14:59 编辑 ]

ke3088 · 发表于 2009-11-2 15:14

我知道您的意思了，还是太麻烦了。我的想法是在发文稿纸里拟好文稿、修改后，直接运行发文稿纸里的宏就OK，自动生成发文登记簿里的数据。谢谢您！

4me · 发表于 2009-11-2 16:31

自己移植代码到word再修改，就行了。

ke3088 · 发表于 2009-11-2 16:57

您的代码是用在EXCEL的，移植在WORD里用，不能识别

4me · 发表于 2009-11-2 17:01

要学会借用修改。

ke3088 · 发表于 2009-11-2 17:07

对我也想学好VBA，目前还靠大家

sylun · 发表于 2009-11-2 22:58

可以试试如下代码，忽略保存位置的判断与添加等问题：

Sub GetInfo()
Dim myArray As Variant, i As Byte, a As String, info As String
Dim AppExcel As Object, WkBook As Object, r As Long
myArray = Array(10, 14, 16, 2, 24, 30)  '主要单元格的索引号
With ActiveDocument
      With .Content.Find  '查找并提取发文日期
         .Text = "^13????年[一-龥]@月[一-龥]@日^13"
         .MatchWildcards = True
         If .Execute Then
            If .Parent.Paragraphs(2).Alignment = wdAlignParagraphRight Then
                  info = Replace(.Parent, Chr(13), "")
                  If IsDate(info) = False Then info = Replace(.Parent, "〇", "○")
                  info = Format(info, "General Date")
            Else
                  MsgBox "没有找到右缩进的发文日期！"
                  Exit Sub
            End If
         Else
            MsgBox "没有找到合适的发文日期！"
            Exit Sub
         End If
      End With
      With .Tables(1).Range  '提取表格中的主要项目
         For i = 0 To UBound(myArray)
            a = Replace(.Cells(myArray(i)).Range, Chr(13) & Chr(7), "")
            a = Trim(a)
            If a = "" Then
                  MsgBox "表格中的主要项目有漏填！"
                  Exit Sub
            Else
                  info = info & "|" & a
            End If
         Next
      End With
End With

'数据写入excel文档
Set AppExcel = CreateObject("Excel.Application")
AppExcel.Visible = True
Set WkBook = AppExcel.Workbooks.Open(ActiveDocument.Path & "\发文登记簿(模板).xls")  '暂设excel文档与发文稿保存在同一目录下
WkBook.Sheets(1).Activate
With WkBook.ActiveSheet
      r = .Range("b2:b65536").End(-4121).Row + 1
      .Cells(r, 1).Formula = "=row() - 2"
      For i = 2 To 8
         .Cells(r, i).Value = Split(info, "|")(i - 2)
      Next
      .Range(.Cells(r, 1), .Cells(r, 8)).Borders.LineStyle = 1
End With
WkBook.Close True
AppExcel.Quit
Set AppExcel = Nothing
MsgBox "数据已成功提取！"
End Sub

4me · 发表于 2009-11-3 09:10

同时打开，word里执行

发文.rar (32 KB, 下载次数: 63)

ke3088 · 发表于 2009-11-3 13:08

sylun兄，谢谢您！运行代码后，可以打开发文登记簿(模板).xls，在.Cells(r, 1).Formula = "=row() - 2"处，但出现以下错误“运行时错误'1004' 应用程序错误定义或对象定义错误”，我也给工具—引用中的EXCEL 11.0前面打勾了。不好意思，再麻烦您看看，是什么原因？致以衷心感谢！
4me兄，谢谢您！更改落款日期格式也不是不可以，但我还觉得使用常规方式比较妥，毕竟公文起草还是要求严谨些为好。不过，还是衷心感谢您的帮助！

[ 本帖最后由 ke3088 于 2009-11-3 13:09 编辑 ]

sylun · 发表于 2009-11-3 16:55

原帖由 ke3088 于 2009-11-3 13:08 发表
sylun兄，谢谢您！运行代码后，可以打开发文登记簿(模板).xls，在.Cells(r, 1).Formula = "=row() - 2"处，但出现以下错误“运行时错误'1004' 应用程序错误定义或对象定义错误”，我也给工具—引用中的EXCEL 11.0前 ...

原来是其前一句的问题，但我昨晚在家测试时是可以通过的。请将其前一行代码改为如下代码再试试（无需引用EXCEL对象库）：
r = .Range("a1:b65536").End(-4121).Row + 1
或者
r = .UsedRange.Rows.Count + 1

程序也可以判断将要记录的数据是否有重复（比如以文号为依据），或者在发现漏填时选定漏填位置，这样也许更完整些。

		自动登录	找回密码
密码			免费注册

[求助] 把发文稿纸中的内容提取到发文登记簿中？