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)是文档中的换行符。

  • 相关阅读:
    CSS 实现隐藏滚动条同时又可以滚动
    手机端自适应布局demo
    手机端自适应布局demo
    手机端自适应布局demo
    七个帮助你处理Web页面层布局的jQuery插件
    一笔画问题
    数组模拟邻接表
    邻接矩阵存图
    BFS 遍历图
    DFS 遍历图
  • 原文地址:https://www.cnblogs.com/cnpirate/p/5157884.html
Copyright © 2011-2022 走看看