[엑셀 VBA] 예약 DB - 8. Listbox 와 폼 컨트롤 연동하고 DB로 보내기

작성자
dra****
작성일
2022-11-09 20:14
조회
61

새로운 프로젝트를 맏게 되었습니다. 상담 및 견적서 자동화입니다.
예약 폼 보다 코드가 간결해지고 재 사용성이 높아지도록 코딩 했습니다.

관계형으로 설계해야할 5개의 테이블이 있고, 5개의 사용자 정의폼이 있고, 5개의 ListObject가 있습니다.
하나의 사용자 정의폼에, 필드만 array()로 재 구성하고 컨트를 이름만 바꿔주거나, 삭제 추가 하면 끝입니다.

예전 같았으면, 2일 정도 노가다를 반복해야 했으나, 이번에는 잘 설계한 사용자 정의폼과 약간의 로직만으로,
2시간 만에 끝냈습니다. 코드도 간결하고... ^^

기초 데이터용 사용자 정의 폼이 있습니다.

이렇게 생긴 폼의 데이터는 시트에 표 ListObject로 있습니다.

Listbox RowSource 속성에 표 이름을 넣어 줍니다.

이렇게 하면 표의 모든 값에 Listbox에 들어가게 됩니다.

여기서 DB table의 칼럼(필드) 목록은 다름과 같습니다.

Private Sub setFields()
    'INSERT
    arrFields = Array("SER", "F_NAME", "F_NO", "ORG", "SH_KOR", "AH_PHIL", "SH_PHIL", "MEMO", "ODR")
    ReDim arrValues(LBound(arrFields) To UBound(arrFields))
    'UPDATE
    arrF = Array("F_NAME", "F_NO", "ORG", "SH_KOR", "AH_PHIL", "SH_PHIL", "MEMO", "ODR")
    ReDim arrV(LBound(arrF) To UBound(arrF))
End Sub

arrFields : 모든 컨트롤 목록

arrF : 는 배열로 DB에 전달할 필드 목록

보통 일련번호(자동 증감) 필드명은 ID를 쓰는 것이 일반적인데, 저는 이러 저러한 이유로 SER 을 쓰는 것을 선호합니다.

각각의 컨트롤(Textbox 등등)의 이름을 필드명과 같게 설정합니다.

 

그리고 Listbox를 클릭했을 때 Listbox의 index를 구해 그 값을 필드에 뿌려 줍니다.

Private Sub lbox_Click()
    isNew = False
    Call populate_lbox_to_controls
 
    serial = Me.SER.value
End Sub
Private Sub populate_lbox_to_controls()
    If enableLbox = False Then Exit Sub
 
    Dim i As Byte
    Dim tmp As Variant
 
    With Me.lbox
        index = .listIndex
        If index < 0 Then Exit Sub
 
        For i = LBound(arrFields) To UBound(arrFields)
            tmp = .List(index, i)
            Me.Controls(arrFields(i)).value = tmp
        Next i
    End With
End Sub

Me.Controls(arrFields(i)).value = tmp : 이게 코드의 전부입니다.

이러면 자동으로 그 값을 각각의 컨트롤에 뿌려 집니다.

사용자 정의폼 소스

이전 포스팅의 MySQL 클래스를 읽으셨다면,

이제 이 소스를 보시면 어떻게 CRUD를 구현했는가 편하게 이해하실 수 있습니다.

Option Explicit
 
' 1. DBTableName 바꾸기
' 2. arrFields() 바꾸기
' 3. Controls 삭제하기
 
Private arrFields(), arrValues()
Private arrF(), arrV()
 
Private index As Integer
Private cntRows As Integer
 
Private enableLbox As Boolean
Private isNew As Boolean
 
Private serial As Long
Private DBTableName As String
Private lobjName As String
 
Private msgName As String
 
Private Sub UserForm_Initialize()
    enableLbox = True
    isNew = False
 
    DBTableName = mdGlobal.dbFlights
    lobjName = mdGlobal.tbFlights
 
    msgName = "항공편"
 
    If clsUtils Is Nothing Then Set clsUtils = New clsUtils
    Call setFields
End Sub
 
Private Sub populate_lbox_to_controls()
    If enableLbox = False Then Exit Sub
 
    Dim i As Byte
    Dim tmp As Variant
 
    With Me.lbox
        index = .listIndex
        If index < 0 Then Exit Sub
 
        For i = LBound(arrFields) To UBound(arrFields)
            tmp = .List(index, i)
            Me.Controls(arrFields(i)).value = tmp
        Next i
    End With
End Sub
 
Private Function refresh() As Boolean
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    On Error GoTo Error_Section
 
    Me.lbox.RowSource = ""
    If mdDB.refresh_table(lobjName, True) = True Then
        Call mdGlobal.setFocus
        Call mdLObj.formatGC
        Me.lbox.RowSource = lobjName
    End If
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    refresh = True
    Exit Function
 
Error_Section:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    mdMessage.err_MSG "frmGC: refresh", Err, msgName & " 테이블 다시 불러오기 실패", False
    refresh = False
End Function
 
Private Sub setFields()
    'INSERT
    arrFields = Array("SER", "F_NAME", "F_NO", "ORG", "SH_KOR", "AH_PHIL", "SH_PHIL", "MEMO", "ODR")
    ReDim arrValues(LBound(arrFields) To UBound(arrFields))
    'UPDATE
    arrF = Array("F_NAME", "F_NO", "ORG", "SH_KOR", "AH_PHIL", "SH_PHIL", "MEMO", "ODR")
    ReDim arrV(LBound(arrF) To UBound(arrF))
End Sub
 
Private Function setValues() As Boolean
    Dim i As Byte
    Dim tmp As Variant
    For i = LBound(arrF) To UBound(arrF)
        tmp = VBA.Trim(Me.Controls(arrF(i)).value)
        If VBA.Len(tmp) = 0 Then tmp = Null
 
        If arrF(i) = "GC" And VBA.Len(tmp) = 0 Then
            MsgBox msgName & " 이름을 입력하세요.", vbCritical + vbOKOnly, "입력 정보"
            setValues = False
            Exit Function
        End If
        arrV(i) = tmp
    Next i
    setValues = True
End Function
 
Private Sub insert()
    Dim result As Long
    If setValues = True Then
 
        On Error GoTo Error_Section
 
        Call setMySQL(True)
        result = MySQL.mysql_INSERT_Array(DBTableName, arrF, arrV)
 
        If result > 0 Then
            If refresh = True Then
                MsgBox "SER: " & result & vbNewLine & msgName & " 테이블에 추가 되었습니다.", vbInformation + vbOKOnly, "데이터 추가"
            End If
            isNew = False
        Else
            MsgBox msgName & "테이블에 추가를 하지 못함. 왜 못했는지 확인 요망.", vbCritical + vbOKOnly, "데이터 추가"
        End If
 
    End If
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    Call setMySQL(False)
    Exit Sub
Error_Section:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    mdMessage.err_MSG "frmGC: insert", Err, msgName & " 데이터 추가 실패", False
    Call setMySQL(False)
End Sub
 
Private Sub update()
    If VBA.Len(serial) = 0 Then
        MsgBox "갱신할 데이터가 없습니다.", vbCritical + vbOKOnly, "데이터 갱신"
        Exit Sub
    End If
 
 
    Dim result As Boolean
    If setValues = True Then
 
        Dim criteria As String: criteria = "SER = " & serial
 
        On Error GoTo Error_Section
 
        Call setMySQL(True)
        result = MySQL.mysql_UPDATE_Recordset(DBTableName, criteria, arrF, arrV)
 
        If result = True Then
            If refresh = True Then
                MsgBox msgName & " 테이블에 갱신 되었습니다.", vbInformation + vbOKOnly, "데이터 갱신"
            End If
        Else
            MsgBox msgName & " 테이블에 데이터 갱힌 못함. 왜 못했는지 확인 요망.", vbCritical + vbOKOnly, "데이터 추가"
        End If
 
    End If
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    Call setMySQL(False)
    Exit Sub
Error_Section:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    mdMessage.err_MSG "frmGC: update", Err, msgName & " 데이터 갱신 실패", False
    Call setMySQL(False)
End Sub
 
Private Sub delete()
    If VBA.Len(serial) = 0 Then
        MsgBox "삭제할 데이터를 선택 하세요.", vbCritical + vbOKOnly, "데이터 삭제"
        Exit Sub
    End If
 
    Dim confirm As VbMsgBoxResult
    confirm = MsgBox("정말 삭제 하시겠씁니까?", vbInformation + vbYesNoCancel, "삭제 확인")
    If confirm <> vbYes Then Exit Sub
 
    Dim strSQL As String
    Dim result As Boolean
 
    On Error GoTo Error_Section
 
    strSQL = "DELETE FROM " & DBTableName & " WHERE SER = " & serial
 
    Call setMySQL(True)
    result = MySQL.mysql_ExecSQL_strSQL(strSQL)
 
    If result = True Then
        If refresh = True Then
            MsgBox msgName & " 테이블에서 삭제 되었습니다.", vbInformation + vbOKOnly, "데이터 삭제"
        End If
    Else
        MsgBox msgName & " 테이블에서 데이터 삭제 못함. 왜 못했는지 확인 요망.", vbCritical + vbOKOnly, "데이터 삭제"
    End If
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    Call setMySQL(False)
    Exit Sub
 
Error_Section:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    mdMessage.err_MSG "frmGC: update", Err, msgName & " 데이터 삭제 실패", False
    Call setMySQL(False)
End Sub
 
Private Sub clearFields()
    Dim i As Byte
 
    For i = LBound(arrFields) To UBound(arrFields)
        Me.Controls(arrFields(i)).value = vbNullString
    Next i
End Sub
 
Private Sub enebleControls(Optional opt As Boolean = True)
    Dim i As Byte
    For i = LBound(arrF) To UBound(arrF)
        Me.Controls(arrF(i)).Enabled = opt
    Next i
End Sub
 
' INSERTING/EDITING MODE Display setting
Private Sub changeMode()
    If isNew = True Then
        Me.lblMode.Caption = "INSERTING"
        Me.lblMode.BackColor = &HC0&
        Me.lblMode.ForeColor = &HFFFF&
 
    Else
        Me.lblMode.Caption = "EDITING"
        Me.lblMode.BackColor = &H8000000F
        Me.lblMode.ForeColor = &H8000000D
    End If
End Sub
 
'controls Events Handling
 
Private Sub btnUPDATE_Click()
    If isNew = True Then
        'INSERT
        Call insert
    Else
        'UPDATE
        Call update
    End If
End Sub
 
Private Sub btnDELETE_Click()
    Call delete
End Sub
 
Private Sub btnNEW_Click()
    isNew = True
    Call clearFields
    Call changeMode
    Call enebleControls
End Sub
 
Private Sub lbox_Click()
    isNew = False
    Call populate_lbox_to_controls
    Call changeMode
    Call enebleControls
 
    serial = Me.SER.value
End Sub
 
Private Sub btnRefresh_Click()
    Call refresh
End Sub
 
Private Sub btnClose_Click()
    Unload Me
End Sub

다섯개의 폼에 필드 관련 배열과 몇가지 변수 이름만 바꿔주고 마무리 지었습니다.

스크랩
공유
회원등급 : 29레벨
포인트 : 4251 EP
전체 0

전체 69
번호 제목 작성자 작성일 추천 조회
알림
「🎉 올해의 책 투표」 '진짜쓰는 실무엑셀' 이 후보에 선정되었습니다! (👉깜짝 이벤트) (51)
오빠두엑셀 | 2022.11.07 | 추천 23 | 조회 7764
오빠두엑셀 2022.11.07 23 7764
공지사항
[VBA] 구하라 그러면 주어질 것이다. - VBA 마스터 E-Book (영문판) 첨부파일 (6)
dra**** | 2022.07.19 | 추천 4 | 조회 354
dra**** 2022.07.19 4 354
44293
[엑셀 VBA] 예약 DB - 9. 시트의 바우처&견적서 양식에 데이터 뿌리기 (3)
dra**** | 2022.11.11 | 추천 1 | 조회 135
dra**** 2022.11.11 1 135
44227
[엑셀 VBA] 예약 DB - 8. Listbox 와 폼 컨트롤 연동하고 DB로 보내기
dra**** | 2022.11.09 | 추천 2 | 조회 61
dra**** 2022.11.09 2 61
44219
[엑셀 VBA] 예약 DB - 7. MySQL 클래스와 사용법 (2)
dra**** | 2022.11.09 | 추천 2 | 조회 57
dra**** 2022.11.09 2 57
43438
[엑셀 VBA] 예약 DB - 6. 폼 콘트롤과 DB 필드명 일치시키기
dra**** | 2022.10.21 | 추천 2 | 조회 93
dra**** 2022.10.21 2 93
43292
[엑셀 VBA] 예약 DB - 5. makeSQL() 함수 - INSERT, UPDATE문 자동 생성 (4)
dra**** | 2022.10.18 | 추천 3 | 조회 108
dra**** 2022.10.18 3 108
43091
[엑셀 VBA] 예약 DB - 4. 표 가지고 놀기 (6)
dra**** | 2022.10.13 | 추천 1 | 조회 188
dra**** 2022.10.13 1 188
43017
[엑셀 VBA] 예약 DB -3. 표(테이블, ListObject)을 사용해야 하는 이유1 (11)
dra**** | 2022.10.11 | 추천 1 | 조회 143
dra**** 2022.10.11 1 143
42998
[잡설] 엑셀이 웹으로 가야하는 이유2 (9)
dra**** | 2022.10.10 | 추천 5 | 조회 258
dra**** 2022.10.10 5 258
42982
[엑셀 VBA] 예약 DB - 2. 다시 웹으로 - Access에서 MySQL로 데이터 이식
dra**** | 2022.10.10 | 추천 2 | 조회 120
dra**** 2022.10.10 2 120
40590
[엑셀 VBA] 예약 DB - 1. 엑세스, SQL, Recordset, ListObject 의 상관 관계 (4)
dra**** | 2022.07.29 | 추천 3 | 조회 339
dra**** 2022.07.29 3 339
40511
[잡설] 엑셀의 꽃 파워 쿼리를 버리다. (3)
dra**** | 2022.07.29 | 추천 4 | 조회 551
dra**** 2022.07.29 4 551
40321
[경험담..해결했습니다.] &H80004005(-2147467259)시스템오류 (3)
티엠프이 | 2022.07.25 | 추천 2 | 조회 278
티엠프이 2022.07.25 2 278
40074
M365 업데이트 이후 발생하는 H80004005 (-2147467259) 자동화 오류 해결방법
오빠두엑셀 | 2022.07.23 | 추천 0 | 조회 276
오빠두엑셀 2022.07.23 - 276
39608
엑셀 그래프에 관한 유튜브 채널정보 입니다. (7)
레몬네이드 | 2022.07.15 | 추천 -1 | 조회 211
레몬네이드 2022.07.15 -1 211
36473
[엑셀VBA] 시트 이름을 변수로 설정하고 싶을때 간단한 방법 (2)
알파고 | 2022.06.27 | 추천 2 | 조회 432
알파고 2022.06.27 2 432
35196
Print_Area 동적 인쇄 영역설정 첨부파일 (1)
sean | 2022.06.21 | 추천 4 | 조회 448
sean 2022.06.21 4 448
34607
셀레니움으로 개별공시지가 조회 첨부파일 (3)
나야 | 2022.06.02 | 추천 1 | 조회 289
나야 2022.06.02 1 289
26273
엑셀 2021, M365 가로스크롤 기능 (28)
더블유에이 | 2022.01.23 | 추천 17 | 조회 840
더블유에이 2022.01.23 17 840
Re:엑셀 2021, M365 가로스크롤 기능
김학동 | 2022.01.23 | 추천 1 | 조회 275
김학동 2022.01.23 1 275
Re:엑셀 2021, M365 가로스크롤 기능
김동희 | 2022.05.30 | 추천 0 | 조회 128
김동희 2022.05.30 0 128
24189
[엑셀 VBA] Snippet - OCR: 이미지 파일을 텍스트 파일로 변환하기 (25)
dra**** | 2021.12.01 | 추천 8 | 조회 2079
dra**** 2021.12.01 8 2079
23999
[엑셀 VBA] Snippet - Public IP, Local IP, Mac Address 구하기 (6)
dra**** | 2021.11.25 | 추천 2 | 조회 758
dra**** 2021.11.25 2 758