미해결 M365윈도우10
SOS 도와쥬세요! 엑셀VBA 자동화 오류
안녕하세요
VBA 코딩된 업무 파일을 사용하고 있는데
VBA 코드 실행중에 자동화 오류가 발생합니다.
'-2147417848 (80010108)'런타임 오류 발생
자동화 오류 입니다.
호출된 개체가 해당 클라인언트로부터 연결이 끊겼습니다.
그리고 파일이 닫히고
다시 열면 좌측에 복구파일 목록 생성
이게 계속 반복되네요. AI 에 물어봐도 딱히 해결책이 없고, 웹서칭도 그렇고..
오빠두 밖에 없어요 ㅠㅠ
도와 쥬세요.. 혹시 필요한 정보나 소스 있음 댓글 쥬세요.. 바로 드릴께요
VBA 코딩된 업무 파일을 사용하고 있는데
VBA 코드 실행중에 자동화 오류가 발생합니다.
'-2147417848 (80010108)'런타임 오류 발생
자동화 오류 입니다.
호출된 개체가 해당 클라인언트로부터 연결이 끊겼습니다.
그리고 파일이 닫히고
다시 열면 좌측에 복구파일 목록 생성
이게 계속 반복되네요. AI 에 물어봐도 딱히 해결책이 없고, 웹서칭도 그렇고..
오빠두 밖에 없어요 ㅠㅠ
도와 쥬세요.. 혹시 필요한 정보나 소스 있음 댓글 쥬세요.. 바로 드릴께요
a
m
히
소
a
댓글 3
코드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
' 이미지 파일 저장 경로 설정
변경전 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만 올리지 말고 파일 자체를 올리세요**