엑셀 견적서 시트 보관 방식
DB 저장 클릭하면
다른 시트에 저장하여 보관하는 방식입니다.
관련 소스
'──────────────────────────────────────────────
' 견적서 통합 매크로 (2025 완전체)
'──────────────────────────────────────────────
Option Explicit
'──────────────────────────────────────────────
' 잠금된 셀 색상 자동 표시
'──────────────────────────────────────────────
Sub 잠금셀색상표시()
Dim ws As Worksheet, c As Range
Set ws = ThisWorkbook.Sheets("견적서")
Application.ScreenUpdating = False
ws.Cells.Interior.ColorIndex = xlNone
' 잠금된 셀만 색 지정 (연한 회색)
For Each c In ws.UsedRange
If c.Locked Then
c.Interior.Color = RGB(240, 240, 240)
Else
c.Interior.Color = RGB(255, 255, 255)
End If
Next c
Application.ScreenUpdating = True
End Sub
'──────────────────────────────────────────────
' 견적서 초기화 (병합 셀 대응 + 공급자 D10 값 반영, 기본문구 제거)
'──────────────────────────────────────────────
Sub 새견적서()
On Error GoTo ErrorHandler
Dim wsDB As Worksheet, wsQuote As Worksheet, wsSupplier As Worksheet
Dim lastRow As Long, lastQuoteNum As String
Dim prefix As String, numPart As String
Dim newNum As Long, hyphenPos As Integer
Dim supplierText As String
Set wsQuote = ThisWorkbook.Sheets("견적서")
Set wsDB = ThisWorkbook.Sheets("DB")
Set wsSupplier = ThisWorkbook.Sheets("공급자")
wsQuote.Unprotect
' 기존 데이터 초기화
wsQuote.Range("E5:F5").ClearContents
wsQuote.Range("A6:G6").ClearContents
wsQuote.Range("D11:S11").ClearContents
wsQuote.Range("C13:S32").ClearContents
wsQuote.Range("I33:S33").ClearContents
wsQuote.Range("I34:S34").ClearContents
wsQuote.Range("I35:S35").ClearContents
' 날짜 자동 입력
wsQuote.Range("E5").MergeArea.Cells(1, 1).Formula = "=TODAY()"
' 공급자 시트의 D10 값을 견적서 D34에 반영
supplierText = wsSupplier.Range("D9").Value
wsQuote.Range("I33").MergeArea.Cells(1, 1).Value = supplierText
supplierText = wsSupplier.Range("D10").Value
wsQuote.Range("I34").MergeArea.Cells(1, 1).Value = supplierText
supplierText = wsSupplier.Range("D11").Value
wsQuote.Range("I35").MergeArea.Cells(1, 1).Value = supplierText
' 공급가액 계산식 재입력
wsQuote.Range("P13:P32").FormulaR1C1 = "=RC[-3]*RC[-1]"
' DB 기준 새 견적서 번호 생성
lastRow = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row
If lastRow < 2 And wsDB.Range("A1").Value = "" Then
wsQuote.Range("C2").Value = "DS-001"
Else
lastQuoteNum = wsDB.Cells(lastRow, "A").Value
hyphenPos = InStr(lastQuoteNum, "-")
If hyphenPos > 0 Then
prefix = Left(lastQuoteNum, hyphenPos)
numPart = Mid(lastQuoteNum, hyphenPos + 1)
newNum = CLng(numPart) + 1
wsQuote.Range("C2").Value = prefix & Format(newNum, String(Len(numPart), "0"))
Else
wsQuote.Range("C2").Value = "DS-001"
End If
End If
' 포커스 이동 및 시트 보호 복원
wsQuote.Range("C2").Select
잠금셀색상표시
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
ErrorHandler:
MsgBox "오류 발생: " & Err.Description, vbCritical
wsQuote.Protect UserInterfaceOnly:=True
End Sub
'──────────────────────────────────────────────
' DB 저장 (덮어쓰기 금지 + 표서식 자동 재적용)
'──────────────────────────────────────────────
Sub DB저장()
On Error GoTo ErrorHandler
Dim wsDB As Worksheet, wsQuote As Worksheet
Dim ID As String, lastRowDB As Long, pasteRowDB As Long, lastRowQuote As Long
Dim i As Long
Dim valueE5 As Variant, valueA6 As Variant, valueD11 As Variant
Dim valueI33 As Variant, valueI34 As Variant
Dim tbl As ListObject
Dim headerRange As Range
Dim newTable As ListObject
Set wsDB = ThisWorkbook.Sheets("DB")
Set wsQuote = ThisWorkbook.Sheets("견적서")
wsQuote.Unprotect
' 기존 표가 있으면 삭제
On Error Resume Next
For Each tbl In wsDB.ListObjects
tbl.Unlist
Next tbl
On Error GoTo ErrorHandler
ID = wsQuote.Range("C2").Value
If ID = "" Then
MsgBox "견적서 번호(C2)를 입력하세요.", vbExclamation
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
End If
' DB에 동일한 ID가 존재하는지 확인
lastRowDB = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match(ID, wsDB.Range("A1:A" & lastRowDB), 0)) Then
MsgBox "이미 존재하는 견적서 번호입니다. 저장할 수 없습니다.", vbExclamation
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
End If
' 견적서에 저장할 데이터가 있는지 확인
lastRowQuote = wsQuote.Cells(wsQuote.Rows.Count, "C").End(xlUp).Row
If lastRowQuote < 13 Then
MsgBox "견적서에 저장할 데이터가 없습니다.", vbExclamation
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
End If
' 첫 데이터 입력 행 계산
If lastRowDB < 2 Then
pasteRowDB = 2
Else
pasteRowDB = lastRowDB + 1
End If
' 견적서 시트 값 읽기
valueE5 = wsQuote.Range("E5").Value
valueA6 = wsQuote.Range("A6").Value
valueD11 = wsQuote.Range("D11").Value
valueI33 = wsQuote.Range("I33").MergeArea.Cells(1, 1).Value
valueI34 = wsQuote.Range("I34").MergeArea.Cells(1, 1).Value
' 데이터 저장
For i = 13 To lastRowQuote
If wsQuote.Range("C" & i).Value = "" Then Exit For
wsDB.Range("A" & pasteRowDB).Value = ID
wsDB.Range("B" & pasteRowDB).Value = valueE5
wsDB.Range("C" & pasteRowDB).Value = valueA6
wsDB.Range("D" & pasteRowDB).Value = valueD11
wsDB.Range("E" & pasteRowDB).Value = wsQuote.Range("C" & i).Value
wsDB.Range("F" & pasteRowDB).Value = wsQuote.Range("I" & i).Value
wsDB.Range("G" & pasteRowDB).Value = wsQuote.Range("K" & i).Value
wsDB.Range("H" & pasteRowDB).Value = wsQuote.Range("M" & i).Value
wsDB.Range("I" & pasteRowDB).Value = wsQuote.Range("O" & i).Value
wsDB.Range("J" & pasteRowDB).Value = wsQuote.Range("P" & i).Value
wsDB.Range("K" & pasteRowDB).Value = ""
wsDB.Range("L" & pasteRowDB).Value = wsQuote.Range("S" & i).Value
wsDB.Range("M" & pasteRowDB).Value = valueI33
wsDB.Range("N" & pasteRowDB).Value = valueI34
pasteRowDB = pasteRowDB + 1
Next i
' 표서식 재적용
Set headerRange = wsDB.Range("A1:N1") ' 헤더 범위 수정 (O열 제외)
Set newTable = wsDB.ListObjects.Add(xlSrcRange, wsDB.Range(headerRange, wsDB.Cells(pasteRowDB - 1, "N")), , xlYes)
newTable.Name = "DBTable"
newTable.TableStyle = "TableStyleLight15" ' 흰색, 표 스타일 밝게 15 적용
MsgBox "견적서 [" & ID & "] 데이터를 DB에 저장했습니다.", vbInformation
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
ErrorHandler:
MsgBox "DB 저장 중 오류 발생: " & Err.Description, vbCritical
wsQuote.Protect UserInterfaceOnly:=True
End Sub
'──────────────────────────────────────────────
' 견적서 불러오기 (I33, I34, I35 적용)
'──────────────────────────────────────────────
Sub 불러오기()
On Error GoTo ErrorHandler
Dim wsDB As Worksheet, wsQuote As Worksheet, wsSupplier As Worksheet
Dim idValue As String
Dim matchRow As Variant, firstRow As Long, lastRow As Long
Dim customer As String, titleValue As String, transactionDate As Variant
Dim note1 As Variant, note2 As Variant, supplierName As Variant
Set wsDB = ThisWorkbook.Sheets("DB")
Set wsQuote = ThisWorkbook.Sheets("견적서")
Set wsSupplier = ThisWorkbook.Sheets("공급자")
wsQuote.Unprotect
idValue = Trim(wsQuote.Range("C2").Value)
If idValue = "" Then
MsgBox "견적서 번호(C2)를 입력하세요.", vbExclamation
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
End If
matchRow = Application.Match(idValue, wsDB.Columns("A"), 0)
If IsError(matchRow) Then
MsgBox "[" & idValue & "] 견적서를 찾을 수 없습니다.", vbCritical
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
End If
firstRow = matchRow
lastRow = firstRow
Do While wsDB.Cells(lastRow + 1, "A").Value = idValue
lastRow = lastRow + 1
Loop
wsQuote.Range("C13:S32").ClearContents
Dim dataCount As Long
dataCount = lastRow - firstRow + 1
wsQuote.Range("C13").Resize(dataCount, 1).Value = wsDB.Range("E" & firstRow & ":E" & lastRow).Value
wsQuote.Range("I13").Resize(dataCount, 1).Value = wsDB.Range("F" & firstRow & ":F" & lastRow).Value
wsQuote.Range("K13").Resize(dataCount, 1).Value = wsDB.Range("G" & firstRow & ":G" & lastRow).Value
wsQuote.Range("M13").Resize(dataCount, 1).Value = wsDB.Range("H" & firstRow & ":H" & lastRow).Value
wsQuote.Range("O13").Resize(dataCount, 1).Value = wsDB.Range("I" & firstRow & ":I" & lastRow).Value
wsQuote.Range("P13").Resize(dataCount, 1).Value = wsDB.Range("J" & firstRow & ":J" & lastRow).Value
wsQuote.Range("S13").Resize(dataCount, 1).Value = wsDB.Range("L" & firstRow & ":L" & lastRow).Value
transactionDate = wsDB.Cells(firstRow, "B").Value
customer = wsDB.Cells(firstRow, "C").Value
titleValue = wsDB.Cells(firstRow, "D").Value
note1 = wsDB.Cells(firstRow, "M").Value
note2 = wsDB.Cells(firstRow, "N").Value
supplierName = wsSupplier.Range("D11").Value
wsQuote.Range("E5").Value = transactionDate
wsQuote.Range("A6").Value = customer
wsQuote.Range("D11").Value = titleValue
' 수정된 부분: D33, D34 → I33, I34, I35
wsQuote.Range("I33").MergeArea.Cells(1, 1).Value = note1
wsQuote.Range("I34").MergeArea.Cells(1, 1).Value = note2
wsQuote.Range("I35").MergeArea.Cells(1, 1).Value = supplierName
wsQuote.Activate
MsgBox "[" & idValue & "] 견적서를 성공적으로 불러왔습니다.", vbInformation
잠금셀색상표시
wsQuote.Protect UserInterfaceOnly:=True
Exit Sub
ErrorHandler:
MsgBox "불러오기 중 오류 발생: " & Err.Description, vbCritical
wsQuote.Protect UserInterfaceOnly:=True
End Sub
'──────────────────────────────────────────────
' PDF 저장
'──────────────────────────────────────────────
Sub PDF저장()
On Error GoTo ErrorHandler
Dim ws As Worksheet, wb As Workbook
Dim pdfFileName As String, pdfFilePath As String, folderPath As String
Dim quoteNum As String, customerName As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("견적서")
ws.Unprotect
quoteNum = Trim(ws.Range("C2").Value)
customerName = Trim(ws.Range("A6").Value)
If quoteNum = "" Then
MsgBox "견적서 번호(C2)가 비어 있습니다.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
If customerName = "" Then
MsgBox "거래처명(A6)이 비어 있습니다.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
folderPath = wb.Path
If folderPath = "" Then
MsgBox "파일을 먼저 저장하세요.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
pdfFileName = quoteNum & "-" & customerName & ".pdf"
pdfFilePath = folderPath & Application.PathSeparator & pdfFileName
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath
MsgBox "PDF 저장 완료: " & pdfFilePath, vbInformation
ws.Protect UserInterfaceOnly:=True
Exit Sub
ErrorHandler:
MsgBox "PDF 저장 중 오류 발생: " & Err.Description, vbCritical
ws.Protect UserInterfaceOnly:=True
End Sub
'──────────────────────────────────────────────
' 엑셀 저장 (시트 보호 유지 + 외부 링크 제거)
'──────────────────────────────────────────────
Sub 엑셀저장()
On Error GoTo ErrorHandler
Dim ws As Worksheet, wb As Workbook, newWb As Workbook
Dim excelFileName As String, excelFilePath As String, folderPath As String
Dim quoteNum As String, customerName As String
Dim shp As Shape, shapesToHide As New Collection, shapeName As Variant
Dim copiedWs As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("견적서")
ws.Unprotect
quoteNum = Trim(ws.Range("C2").Value)
customerName = Trim(ws.Range("A6").Value)
If quoteNum = "" Then
MsgBox "견적서 번호(C2)가 비어 있습니다.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
If customerName = "" Then
MsgBox "거래처명(A6)이 비어 있습니다.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
folderPath = wb.Path
If folderPath = "" Then
MsgBox "파일을 먼저 저장하세요.", vbExclamation
ws.Protect UserInterfaceOnly:=True
Exit Sub
End If
excelFileName = quoteNum & "-" & customerName & ".xlsx"
excelFilePath = folderPath & Application.PathSeparator & excelFileName
' 도형 중 그림이 아닌 것은 숨기기
For Each shp In ws.Shapes
If shp.Type <> msoPicture And shp.Visible = msoTrue Then
shp.Visible = msoFalse
shapesToHide.Add shp.Name
End If
Next shp
' 시트 복사
ws.Copy
Set newWb = ActiveWorkbook
Set copiedWs = newWb.Sheets(1)
' 숨겼던 도형 복원
For Each shapeName In shapesToHide
ws.Shapes(shapeName).Visible = msoTrue
Next shapeName
' 복사된 시트에서 수식 제거 (값만 남기기)
copiedWs.UsedRange.Value = copiedWs.UsedRange.Value
' 불필요한 도형 제거
Application.DisplayAlerts = False
For Each shp In copiedWs.Shapes
If shp.Type <> msoPicture Then shp.Delete
Next shp
Application.DisplayAlerts = True
' 새 파일에서도 시트 보호 유지
copiedWs.Protect UserInterfaceOnly:=True
newWb.SaveAs Filename:=excelFilePath, FileFormat:=xlOpenXMLWorkbook
newWb.Close False
MsgBox "엑셀 저장 완료: " & excelFilePath, vbInformation
ws.Protect UserInterfaceOnly:=True
Exit Sub
ErrorHandler:
MsgBox "엑셀 저장 중 오류 발생: " & Err.Description, vbCritical
ws.Protect UserInterfaceOnly:=True
End Sub