메뉴
미해결 M365윈도우10

SOS 도와쥬세요! 엑셀VBA 자동화 오류

a
1월 23일 조회 1,924
안녕하세요

VBA 코딩된 업무 파일을 사용하고 있는데

 

VBA 코드 실행중에 자동화 오류가 발생합니다.

 

'-2147417848 (80010108)'런타임 오류 발생

자동화 오류 입니다.

호출된 개체가 해당 클라인언트로부터 연결이 끊겼습니다.

 

그리고 파일이 닫히고

다시 열면 좌측에 복구파일 목록 생성

 

이게 계속 반복되네요. AI 에 물어봐도 딱히 해결책이 없고, 웹서칭도 그렇고..

오빠두 밖에 없어요 ㅠㅠ

도와 쥬세요.. 혹시 필요한 정보나 소스 있음 댓글 쥬세요.. 바로 드릴께요

댓글 3

김
김재규 1월 23일
파일 올려보세요
a
awesome 작성자 1월 24일
자주 발생하는 코드가 아래 1번 코드를 실행하고 나면, 2번 코드 실행할때 자동화 오류 메시지가 뜨고, 파일이 닫혀버리곤 합니다.

코드1

Private Sub 버튼_확정서보기_Click()

Dim filePath As String
Dim pdfName As String
Dim imagePath As String
Dim wb As Workbook
Dim sheet As Worksheet
Dim savePath As String
Dim i As Integer

' 파일 선택 다이얼로그 표시 및 선택된 파일 열기
With Application.fileDialog(msoFileDialogFilePicker)
.title = "확정서 파일 선택"
.Filters.Clear
.Filters.Add "모든 파일", "*.*"
.AllowMultiSelect = False

If .Show = -1 Then
filePath = .SelectedItems(1)
Set wb = Workbooks.Open(filePath)
Else
' 파일 선택이 취소된 경우 프로시저 종료
Exit Sub
End If
End With

' 이미지 파일 이름 입력
pdfName = InputBox("이미지 파일 이름을 입력하세요", "이미지 파일 저장")
If pdfName = "" Then Exit Sub

' 모든 시트를 이미지로 저장
For Each sheet In wb.Sheets
With sheet.PageSetup
.printArea = ""
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With

' 이미지 파일 저장 경로 설정
i = i + 1
savePath = "C:\Users\****\OneDrive - *******.com\문서\확정서\" & pdfName & "_" & i & ".jpg"

' 시트를 이미지로 저장
sheet.ExportAsFixedFormat Type:=xlTypeJPEG, fileName:=savePath
Next sheet

' 파일 닫기
wb.Close SaveChanges:=False

' 저장한 파일의 폴더 열기
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open "C:\Users\****\OneDrive - *******.com\문서\확정서\"

' 메시지 출력
MsgBox "확정서 변환 완료", vbInformation, "완료"

End Sub

코드2

Private Sub 불러오기_Click()

'1.상품코드입력: 상품코드 입력 메시지와 함께 인풋박스를 실행하고 입력값을 텍스트박스 상품코드에 반환
Dim productCode As String
productCode = InputBox("상품코드를 입력하세요")
상품코드.Text = productCode

'2.행번호검색: 예약관리 시트에서 일치하는 행을 찾고 그 행번호를 텍스트박스 행번호에 반환
Dim ROWNUMBER As Variant
On Error Resume Next
ROWNUMBER = Application.Match(productCode, Sheets("예약관리").Range("A:A"), 0)
On Error GoTo 0
If Not IsError(ROWNUMBER) Then
행번호.Text = ROWNUMBER
Else
MsgBox "해당 상품코드를 찾을 수 없습니다.", vbExclamation
Exit Sub
End If

'3.GETDB함수실행: DB 변수 지정하여 GET_DB함수로 예약관리 시트를 DB로 메모리에 저장
Dim DB As Variant
DB = Get_DB()

'4.예약관리 값 반환: DB의 5번~60번 항목 값을 텍스트박스에 반환
Dim i As Integer
For i = 5 To 60
Controls("TextBox" & i).Text = DB(ROWNUMBER, i)
Next i

'TL날짜 형식 지정
TextBox29 = Format(TextBox29, "mm/dd(aaa)")
TextBox30 = Format(TextBox30, "mm/dd(aaa)")
TextBox31 = Format(TextBox31, "mm/dd(aaa)")
TextBox32 = Format(TextBox32, "mm/dd(aaa)")

'5.예약정보 갱신:예약조회 프로시저 실행, 상품DB에서 검색코드와 일치 하는 값을 반환, 수정은 예약조회 프로시저에서 해야 함
예약조회_Click

'6.예약정보 불러오기 완료: 메시지 출력 후 예약조회 프로시저 종료
'MsgBox "불러오기 완료!", vbInformation

'7.견적정보 갱신- 견적행번호 찾기 :※수정필요, 견적번호,순번 미입력해도 결과가 나오는 오류 수정해야 함
Dim ws As Worksheet '견적시트
Dim QARng As Range '검색범위
Dim QARow As Range '검색결과
Dim Searchtxt1 As String '검색어1:견적번호
Dim Searchtxt2 As String '검색어2:순번

Set ws = ActiveWorkbook.Sheets("견적") '견적시트 지정
Set QARng = ws.Range("A:E")
Searchtxt1 = TextBox5.Value '검색어1은 Textbox5의 값
Searchtxt2 = TextBox6.Value '검색어2는 Textbox6의 값

MsgBox "견적번호는 " & Searchtxt1 & "이고, 견적순번은 " & Searchtxt2 & "입니다."

Dim firstResult As Range, secondResult As Range

''''첫 번째 조건으로 검색
Set firstResult = QARng.Find(What:=Searchtxt1, LookIn:=xlValues, LookAt:=xlWhole)

If Not firstResult Is Nothing Then
''''' 두 번째 조건으로 검색
Set secondResult = QARng.Find(What:=Searchtxt2, After:=firstResult, LookIn:=xlValues, LookAt:=xlWhole)

If Not secondResult Is Nothing Then
Set QARow = ws.Rows(secondResult.row)
QATextBox0.Value = QARow.row
Else
QATextBox0.Value = ""
End If
Else
MsgBox "견적정보를 찾을 수 없습니다."
End If

On Error Resume Next
'견적정보 갱신- 견적값을 QATEXTBOX1~10에 넣기, 항공,유택,보험,FOC,인당호텔,인당행사,원가,입금가,인당수익,수익율
QATextBox1.Value = Sheets("견적").Cells(QARow.row, 15).Value
QATextBox2.Value = Sheets("견적").Cells(QARow.row, 17).Value
QATextBox3.Value = Sheets("견적").Cells(QARow.row, 18).Value
QATextBox4.Value = Sheets("견적").Cells(QARow.row, 19).Value
QATextBox5.Value = Sheets("견적").Cells(QARow.row, 27).Value
QATextBox6.Value = Sheets("견적").Cells(QARow.row, 28).Value
QATextBox7.Value = Sheets("견적").Cells(QARow.row, 30).Value
QATextBox8.Value = Sheets("견적").Cells(QARow.row, 31).Value
QATextBox9.Value = Sheets("견적").Cells(QARow.row, 32).Value
QATextBox10.Value = Sheets("견적").Cells(QARow.row, 33).Value
QATextBox12.Value = Sheets("견적").Cells(QARow.row, 26).Value '견적환율

'7-1 견적DB시트에서 계약결과값 반환
' "견적DB" 시트에서 조건에 맞는 행을 찾아서 4번째 열의 값을 반환하는 코드
Dim wsDB As Worksheet
Set wsDB = ActiveWorkbook.Sheets("견적DB") ' "견적DB" 시트 설정

Dim matchedRow As Range ' 조건에 맞는 행을 저장할 변수
Dim LastRow As Long
LastRow = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).row ' "견적DB" 시트의 마지막 행 번호

' "견적DB" 시트의 A열과 B열에서 조건에 맞는 행을 찾기
For i = 1 To LastRow
If wsDB.Cells(i, "A").Value = Searchtxt1 And wsDB.Cells(i, "B").Value = Searchtxt2 Then
Set matchedRow = wsDB.Rows(i)
Exit For
End If
Next i

' 조건에 맞는 행을 찾았다면 QATextBox11에 4번째 열의 값을 설정
If Not matchedRow Is Nothing Then
QATextBox11.Value = matchedRow.Cells(1, 4).Value ' 4번째 열의 값
Else
MsgBox "견적번호와 견적순번이 일치하는 데이터를 찾을 수 없습니다."
End If

On Error GoTo 0

MsgBox "불러오기 완료!", vbInformation

End Sub
김
김재규 1월 24일
@awesome 님 엑셀파일 자체를 jpg,  JPEG등 이미지 파일로 저장 불가-->PDF는 가능

' 이미지 파일 저장 경로 설정
변경전 savePath = "C:\Users\****\OneDrive - *******.com\문서\확정서\" & pdfName & "_" & i & ".jpg"
변경후 savePath = "C:\Users\****\OneDrive - *******.com\문서\확정서\" &f pdfName & "_" & i & ".pdf"

' 시트를 이미지로 저장
변경전 sheet.ExportAsFixedFormat Type:=xlTypeJPEG, fileName:=savePath
변경후 sheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=savePath

변경전 .printArea = ""  '시트 전체
변경후 .printArea ="$A$1:$G$30"(예)

 

**다음에는 이런 경우 coding만 올리지 말고 파일 자체를 올리세요**

질문답변 게시판의 최근 글

스크랩 완료