[求助]excel和word的数据交换

zjjpags

请指点在word表中的职工编号中输入001,后面的姓名,姓别,出生年月,参工时间,自动填入excel中,001一行中的数据?

当输入002时,自动填入excel中,002一行的数据?

请多多指导

[此贴子已经被作者于2005-6-10 10:01:54编辑过]

守柔

以下是引用zjjpags在2005-6-10 10:00:00的发言：

请指点在word表中的职工编号中输入001,后面的姓名,姓别,出生年月,参工时间,自动填入excel中,001一行中的数据?

当输入002时,自动填入excel中,002一行的数据?

请多多指导

这个东东这样设计,一点也不合理.直接放在EXCEL中,使用VLOOKUP函数可以非常方便地做到.

反之,使用WORD的邮件合并,也可以将数据取出来.

按楼主的意思,我示意性做了一个,通过AUTOMATIO自动化方法,

以下代码供参考: '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-6-26 10:58:39 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub ExampleToGetExcelData() '运行此宏前,请先在VBE/工具/引用中,勾选对于"Microsoft Excel 10.0 Objecd Library"的引用 Dim MyExlApp As Excel.Application, MyExlWk As Excel.Workbook, MyXlsRange As Excel.Range Dim MyXlsaCell As Excel.Range, xlsLastAddress As String, MyCell As Excel.Range Dim MyWdTable As Table, aCell As Cell, KeyRange As Range, i As Integer, TF As Boolean '定义一个表格对象,为本文档的第一个表格 Set MyWdTable = ThisDocument.Tables(1) With MyWdTable '定义一个WORD RANGE对象,为2,2单元格的内容部分 Set KeyRange = ThisDocument.Range(.Cell(2, 2).Range.Start, .Cell(2, 2).Range.End - 1) '如果KEYRANGE对象文本为"",即没有录入编号则提示后退出程序 If KeyRange = "" Then MsgBox "职工编号不得为空!", vbExclamation + vbOKCancel, "Warning" Exit Sub Else '如果任务栏中已有EXCEL程序在运行 If Tasks.Exists("Microsoft Excel") = True Then '则获取该EXCEL程序对象的引用 Set MyExlApp = GetObject(, "Excel.Application") '加入一个识别对象 TF = True Else '反之,则创建对EXCEL程序的引用 Set MyExlApp = CreateObject("Excel.Application") End If '打开同一文件夹下的"DATABASE.XLS"工作薄 Set MyExlWk = MyExlApp.Workbooks.Open(ThisDocument.Path & "\DataBase.xls") '取得A列的最后一个有数据单元格地址 xlsLastAddress = MyExlWk.Sheets(1).[A65536].End(xlUp).Address '定义一个EXCEL RANGE对象 Set MyXlsRange = MyExlWk.Sheets(1).Range("A2:" & xlsLastAddress) '定义一个EXCEL RANGE对象,为对指定区域的查找 Set MyCell = MyXlsRange.Find(KeyRange, LookIn:=xlValues) '如果在指定区域中没有查找到指定的文本内容,则提示并退出程序运行 If MyCell Is Nothing Then MsgBox "EXCEL没有找到该职工编号,请检查录入是否正确!", vbExclamation + vbOKCancel, "Warning" .Cell(2, 2).Range.Select '选中该错误的单元格 GoTo GN '返回到指定行号 Else For i = 2 To 4 '将数值赋值此指定单元格 .Cell(2, i * 2).Range = MyCell.Offset(, i - 1) Next .Cell(3, 8).Range = MyCell.Offset(, 4) End If End If End With GN: MyExlWk.Close False '关闭并不保存EXCEL工作薄 '如果本来就不存在EXCEL程序,则关闭程序,并释放对象变量 If TF = False Then MyExlApp.Quit: Set MyExlApp = Nothing End Sub '----------------------

no5T0W5s.zip (16.56 KB, 下载次数: 221)

2005-6-26 10:59 上传

点击文件名下载附件
[求助]excel和word的数据交换

zjjpags

谢谢!第二楼的老大,我还是不太明白.如在EXCEL中,使用VLOOKUP函数该怎样用?请再指教.[em04]

守柔

这是一个基本函数，在WORD版讨论呢，可能不是太全面。

建议楼主到函数版，搜索一下，"VLOOKUP",你会惊叹于它的常用和方便!

hhzjxss

不错，谢谢了，如果把宏不是在WORD里面做，而是在EXCEL里面，该怎么做呢？

守柔

QUOTE:

以下是引用hhzjxss在2007-3-5 21:18:06的发言：

不错，谢谢了，如果把宏不是在WORD里面做，而是在EXCEL里面，该怎么做呢？

示例：

Sub WriteToWordTable()

'请在EXCEL VBE中勾选对于WORD的引用.
    Dim wdDoc As Word.Document, wdTable As Word.Table
    Dim myRange As Range, lngRow As Long
    Set wdDoc = CreateObject(ThisWorkbook.Path & "\Example.doc")
    Set wdTable = wdDoc.Tables(1)
    lngRow = ActiveCell.Row
    Set myRange = ActiveSheet.Cells(lngRow, 1)
    With wdTable
        .Cell(2, 2).Range.Text = VBA.Format(myRange.Value, "000")
        .Cell(2, 4).Range.Text = myRange.Offset(, 1).Value
        .Cell(2, 6).Range.Text = myRange.Offset(, 2).Value
        .Cell(2, 8).Range.Text = myRange.Offset(, 3).Value
        .Cell(3, 8).Range.Text = myRange.Offset(, 4).Value
    End With
    wdDoc.Application.Visible = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        If MsgBox("是否将当前数据写到Word表格中?",vbYesNo) = vbYes Then Call Me.WriteToWordTable
    End If
End Sub

自得其乐

确实不错，同时利用了WORD 强大的排版和EXCEL的数据处理功能。

vickiyan

这个功能很好呀

byhyxb

学习学习......

lyb200

学习了。。。。。。。。。。。