zoukankan      html  css  js  c++  java
  • 将word文档A表格中的内容拷贝到word文档B表格中

    Function IsFileExists(ByVal strFileName As String) As Boolean
        If Dir(strFileName, 16) <> Empty Then
            IsFileExists = True
        Else
            IsFileExists = False
        End If
    End Function
    
    Sub setname()
        Dim I As Integer
        Dim J As Integer
        Dim pspname As String
        Dim pspnumber As String
        Dim tstname As String
        Dim tstnumber As String
        Dim path As String
        Dim srcPath As String
        Dim srcPath2 As String
        Dim headName As String
        Dim headName2 As String
        Dim txthead As String
        
        Dim wordApp As Object
        Dim wordDoc As Object
        Dim wordDoc2 As Object
        Dim wordArange As Object
        Dim wordSelection As Object
        Dim ReplaceSign As Boolean
        
        Dim Search1 As String
        Dim Search2 As String
        Dim docPrefix As String
        Dim docSuffix As String
        Dim rangSize As Integer
        Dim stringTable1 As String
        
            
        'docPrefix = "-PSP"
        'docSuffix = "采购规格书.doc"
        'Search1 = "电线"
        'Search2 = "6000397-PSP"
        'rangSize = 200
        
        docPrefix = "-"
        docSuffix = "入场检验报告.doc"
        Search1 = "高压电源"
        Search2 = "6000000-TST"
        'Search1 = "AC-DC开关电源"
        'Search2 = "6000412-TST"
        rangSize = 60
        
        J = 1
        Dim myItem
        'myItem = Array(14, 16, 17, 18, 22, 23, 24, 26, 27, 31, 32, 33, 34, 35, 36, 48, 50, 55, 56, 62, 63, 64, 65, 66, 67, 68, 69, 71, 73, 77, 79, 102, 114, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 172, 173, 174, 175, 176, 177, 179, 180, 181)
        For I = 1 To 187
            'srcPath = "C:cygwin	mpBOM	st16.doc"
            'If ActiveSheet.Cells(I, 5) = "" Then
            '    headName2 = ActiveSheet.Cells(I, 3) & "-" & ActiveSheet.Cells(I, 4) & "-" & ActiveSheet.Cells(I, 5)
            '    headName = headName2 & docSuffix
            '    headName3 = ActiveSheet.Cells(I, 4)
            'Else
            '    headName2 = ActiveSheet.Cells(I, 3) & "-" & ActiveSheet.Cells(I, 4) & "-" & ActiveSheet.Cells(I, 6)
            '    headName = headName2 & docSuffix
            '    headName3 = ActiveSheet.Cells(I, 4) & "(" & ActiveSheet.Cells(I, 5) & ")"
            'End If
            'headName = Replace(headName, "/", "-")
            path = "D:om"
            srcPath2 = path & "aa.doc"
            'pspname = path & "" & ActiveSheet.Cells(I, 3) & docPrefix & ActiveSheet.Cells(I, 4) & docSuffix
            pspname = "D:om" & ActiveSheet.Cells(I, 3) & "-PSP-V1.0.doc"
            tstname = "D:om" & ActiveSheet.Cells(I, 3) & "-TST-V1.0.doc"
            tstnumber = ActiveSheet.Cells(I, 3) & "-TST"
            
            headName = ActiveSheet.Cells(I, 4)
            headName2 = ActiveSheet.Cells(I, 3)
            
            pspname2 = "D:omaa" & ActiveSheet.Cells(I, 3) & "-PSP-V1.0.doc"
            
            If IsFileExists(pspname) = True Then
                'FileCopy srcPath, srcPath2
                'Name srcPath2 As tstname
                'headName = ActiveSheet.Cells(I, 4).Value
                'headName2 = ActiveSheet.Cells(I, 3)
                Set wordApp = CreateObject("Word.Application")                  '建立WORD实例
                wordApp.Visible = False                                         '屏蔽WORD实例窗体
                Set wordDoc = wordApp.Documents.Open(pspname)                   '打开文件并赋予文件实例
                'Set wordSelection = wordApp.Selection                           '定位文件实例
                'Set wordArange = wordApp.ActiveDocument.Range(0, rangSize)      '指定文件编辑位置
                'wordArange.Select                                               '激活编辑位置
                
                'stringTable1 = wordDoc.Tables(4).Cell(2, 1)
                
                Set wordDoc2 = wordApp.Documents.Open(pspname2)
                'stringTable1 = Trim(wordDoc.Tables(1).Cell(2, 2).Range.Text)
                'wordDoc2.Tables(1).Cell(2, 2) = wordDoc.Tables(1).Cells(2, 2)
                wordDoc2.Tables(1).Cell(2, 2).Range.Text = Replace(wordDoc.Tables(1).Cell(2, 2).Range.Text, Chr(13), "")
                wordDoc2.Tables(1).Cell(2, 3).Range.Text = Replace(wordDoc.Tables(1).Cell(2, 3).Range.Text, Chr(13), "")
                
                wordDoc2.Tables(1).Cell(3, 2).Range.Text = Replace(wordDoc.Tables(1).Cell(3, 2).Range.Text, Chr(13), "")
                wordDoc2.Tables(1).Cell(3, 3).Range.Text = Replace(wordDoc.Tables(1).Cell(3, 3).Range.Text, Chr(13), "")
                
                wordDoc2.Tables(1).Cell(4, 2).Range.Text = Replace(wordDoc.Tables(1).Cell(4, 2).Range.Text, Chr(13), "")
                wordDoc2.Tables(1).Cell(4, 3).Range.Text = Replace(wordDoc.Tables(1).Cell(4, 3).Range.Text, Chr(13), "")
                
                wordDoc2.Tables(2).Cell(1, 4).Range.Text = headName2
                wordDoc2.Tables(2).Cell(2, 4).Range.Text = ""
                'wordDoc2.Tables(2).Cell(2, 2).Range.Text = Replace(wordDoc.Tables(2).Cell(3, 2).Range.Text, Chr(13), "")
                wordDoc2.Tables(2).Cell(3, 2).Range.Text = Replace(wordDoc.Tables(2).Cell(4, 2).Range.Text, Chr(13), "")
                wordDoc2.Tables(2).Cell(3, 4).Range.Text = Replace(wordDoc.Tables(2).Cell(3, 2).Range.Text, Chr(13), "")
                
                wordDoc2.Tables(3).Cell(2, 1).Range = wordDoc.Tables(4).Cell(2, 1).Range
                
                wordDoc.Save
                wordDoc.Close True
                wordDoc2.Save
                wordDoc2.Close True
                wordApp.Quit
                J = J + 1
            End If
        Next I
    
    End Sub

    特别注意 Chr(13)是文档中的换行符。

  • 相关阅读:
    [Leetcode]Linked List Cycle
    [Leetcode]Excel Sheet Column Number
    [Leetcode]Unique Binary Search Trees
    [Leetcode]Same Tree
    同时访问内外网设置路由信息
    希腊字母表示及读音
    jni入门
    查看某个进程运行时间的几种方法
    企业级hbase HA配置
    存在单点故障的namenode宕机恢复测试
  • 原文地址:https://www.cnblogs.com/cnpirate/p/5157884.html
Copyright © 2011-2022 走看看