아래 코드는 Excel 열의 셀에서 문자열을 순차적으로 복사하고 (i = 3 ~ 61) 동일한 .doc 파일의 여러 복사본이 포함 된 디렉토리 폴더를 찾은 다음 각 문자열을 두 번째 행에 붙여 넣는 데 사용됩니다 . 각 .doc 파일에있는 첫 번째 테이블의 첫 번째 열.
문제 : 프로그램이 의도하지 않게 루프를 계속하고 처음으로 다음 줄을 실행 한 후 나머지 코드 실행을 완료합니다.
wddoc.Tables(1).Cell(2, 1).Range.Paste
이 코드 줄에 도달하기 위해 F8을 사용하여 각 코드 줄을 입력하더라도 발생합니다. 코드는 디렉토리의 나머지 파일에 아무것도 붙여 넣지 않고 실행을 완료합니다. (Excel 문서의 행 3에있는 문자열이 계획 템플릿 에 성공적으로 붙여 넣어졌습니다 -Copy (10) .docx 이지만 나머지 문자열은 나머지 파일에 붙여 넣지 않았습니다)
코드:
Option Explicit
Sub CopyExcelToWord(path As String)
'variables----------------------------------------------------------------
'Decare Object variables for the Word application and file or documentl
Dim wdapp As Object, wddoc As Object, i As Integer
'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String
'main process----------------------------------------------------------
'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
End If
'Our application is made visible
wdapp.Visible = True
currentPath = Dir(path, vbDirectory)
For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
Debug.Print path & currentPath
Sheet1.Range(Cells(i, 2), Cells(i, 2)).Copy
'we activate our MS Word instance
wdapp.Activate
Set wddoc = wdapp.Documents(path & currentPath)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(path & currentPath)
wddoc.Activate
wddoc.Tables(1).Cell(2, 1).Range.Paste
'Free alocated memory and close
wdapp.Quit
Set wddoc = Nothing
Set wdapp = Nothing
'The following line of code removes the cell selection in Excel
Application.CutCopyMode = False
currentPath = Dir()
Else
currentPath = Dir()
End If
Loop
Next
End Sub
인쇄 ( 경로 섹션을 생략 한 곳에 ' ... ' 을 배치했습니다 ) :
. . ... 계획 템플릿-복사 (10) .docx LC : ** ... ** \ 계획 템플릿-복사 (10) .docx
프로그램은 의도하지 않게 나머지 코드를 실행합니다. Excel 문서의 행 3에있는 문자열이 계획 템플릿-Copy (10) .docx 에 성공적으로 붙여 졌지만 나머지 문자열은 나머지 파일에 붙여 넣어지지 않았습니다.
plan template Copy (11) .docx LC : * ... ** \ plan template-Copy (11) .docx Lesson plan template-Copy (12) .docx LC : * ... \ plan template -Copy (12) .docx 계획 템플릿-복사 (13) .docx LC : ** ... \ 계획 템플릿-L ... C : * ... ** \ 계획 템플릿-복사 (9) .docx 강의 계획 템플릿 .docx LC : * ... ** \ plan template.docx
'문제'는 붙여 넣기 명령과 관련이 없습니다.
코드는 모든 오류를 무시하도록 설정하고 Word 응용 프로그램 개체를 만든 다음 다음과 같은 루프에 들어갑니다.
루프의 첫 번째 반복은 성공적으로 실행되지만 개체가 더 이상 존재하지 않으므로 Word를 포함하는 각 줄에서 후속 반복이 오류가 발생합니다. 이러한 오류는 때문에 무시 On Error Resume Next됩니다.
해야 할 일 :
wdapp.quit루프 밖으로 이동Word는 클립 보드 기록을 유지하고 단일 셀의 값만 복사하므로 복사 붙여 넣기를 사용하지 않습니다. 대신 테이블 셀에 값을 직접 씁니다.
이것이 내가 코드를 작성하는 방법입니다.
Option Explicit
Sub CopyExcelToWord(path As String)
'variables----------------------------------------------------------------
'Decare Object variables for the Word application and file or document
Dim wdapp As Object, wddoc As Object, i As Integer
'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String
'declare flag to show if Word needs to be quit
Dim quitWord As Boolean
'main process----------------------------------------------------------
'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
'as Word wasn't already open make application visible
wdapp.Visible = True
'set flag to show Word needs to be shut down
quitWord = True
End If
'reset error handling so that any subsequent errors aren't ignored
On Error GoTo 0
currentPath = Dir(path, vbDirectory)
For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
Debug.Print path & currentPath
Set wddoc = wdapp.Documents.Open(path & currentPath)
wddoc.Tables(1).Cell(2, 1).Range.Text = Sheet1.Range(Cells(i, 2), Cells(i, 2)).Value
'document no longer required so close and save changes
wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
Set wddoc = Nothing
currentPath = Dir()
Else
currentPath = Dir()
End If
Loop
Next
'Now that operations involving Word are complete quit Word if necessary and destroy objects
If quitWord Then wdapp.Quit
Set wdapp = Nothing
End Sub
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다