PROGRAMMING WORKSHOP

문서작성자동화|시공검측요청서

기능별 코딩하기

UserForm이 뜨면서
아래와 같이 checkFolders 프로시져를 호출한다
사진화일을 보관할 폴더와 요청서별 통합문서를 만들 홀더가 있는지
확인하여 없으면 만들어 놓는다

Private Sub UserForm_Initialize()
...
...
checkFolders
...
...
End Sub

Sub checkFolders()
sFilePath = ThisWorkbook.Path & "\"
On Error Resume Next
If Dir(sFilePath & FILE_FOLDER, vbDirectory) = "" Then
    VBA.MkDir sFilePath & FILE_FOLDER
End If
If Dir(sFilePath & IMAGE_FOLDER, vbDirectory) = "" Then
    VBA.MkDir sFilePath & IMAGE_FOLDER
End If
End Sub

이미지콘트롤에 그림올리기
요청서상에 그림을 모두 4장까지 넣기로 하고
스크롤바의 Min값은 1, Max값은 4로 하여 현재 그림의 위치를 알리기 위하여
Label 콘트롤을 하나 더 추가하자



스크롤바의 값을 이동하면
해당 몇번째 그림을 폴더에서 찾아서 이미지콘트롤에 나타나게 한다

그림을 해당 요청서에 따라서 해당 그림을 올려주어야 할것이다
그림을 올려야 하는 경우는
1)요청서 탭을 선택할때의 이벤트에서 그림을 올려야 하고
2)해당 요청서에서 4장의 그림을 네비게이팅하는 스크롤바에서 올려야 한다
그러니 별도의 프로시져를 만들고 , 각각 매개변수를 주고 호출하면 될 것이다
매개변수는 현재요청서목록시트명인지, 목록시트상의 몇번째요청서인지,그리고 몇번째그림인지의
정보를 전달하면 될 것이다

Sub loadPic(sListSheetName As String, iCurrentIndex As Integer, iPicNum As Integer)
Dim sFirstPic As String
'' 전달받은 매개변수로 그림화일명을 만들고, 그림 화일은 확장자 .jpg로 한다
sFirstPic = ThisWorkbook.Path & "\pics\" & sListSheetName & "_" & iCurrentIndex & "_" & iPicNum & ".jpg"

If Dir(sFirstPic) <> "" Then
    picBox.Picture = LoadPicture(sFirstPic)
Else
'' 해당그림명을 찾아서 없으면 이미지상자의 Picture 속성을 Nothing으로 하여 지우고..
   Set picBox.Picture = Nothing
End If
End Sub

스크롤바콘트롤의 값이 바뀌면..
위의 loadPic 프로시져를 호출하고..

Private Sub picScrollBar_Change()
On Error Resume Next
Me.Controls("myLabel").Caption = picScrollBar.Value & " OF 4"
loadPic modMain.shtCurrentList.Name, Val(sCurrentTab), picScrollBar.Value
End Sub

MultiTab 콘트롤의 탭이 바뀌면 아래의 이벤트가 위의 loadPic을 호출한다

Private Sub multiTab_Change()
sCurrentTab = multiTab.SelectedItem.Caption
If sCurrentTab = "그림" Then sCurrentTab = ""
picScrollBar.Enabled = True
loadPic modMain.shtCurrentList.Name, Val(sCurrentTab), 1
End Sub

[그림새로선택저장]버튼 크릭이벤트 프로시져에는..
각각의 검사요청서마다 그림이 4장을 사용하게 되어있다
해당 그림이 이미 저장이 되어있다면 자동으로 해당 요청서를 선택하면 UserForm의
Image 컨트롤에 표현된다
그런데 그림이 마음에 안들어서 다른 폴더에 저장된 것으로 새로 갱신하고 싶을때..
이전 화일은 삭제되고 새로 선택한 것으로 저장된다
그리고 아직 그림이 존재하지 않는 것은 새로 선택하여 저장하도록 하여
그림화일을 UserForm에서 쉽게 콘트롤하게 하는 기능이다

Private Sub btnImage_Click()
Dim sImage As String
Dim sPicPath As String
Dim iNextPic As Integer
Dim sPath As String
On Error Resume Next
sPath = ThisWorkbook.Path & "\pics\" & modMain.shtCurrentList.Name & "_" & Val(sCurrentTab) & "_"

If IsNumeric(sCurrentTab) Then
    sPicPath = sPath & Me.picScrollBar.Value & ".jpg"
      '' 첫번째 그림부터 존재하도록 제어
    If Me.picScrollBar.Value > 1 Then
        For iNextPic = 1 To Me.picScrollBar.Value - 1
            If Dir(sPath & iNextPic & ".jpg") = "" Then
                '' 현재스크롤값을 유효한 값으로 바꾸고
                Me.picScrollBar.Value = iNextPic
                '' 저장될 그림의 화일명을 해당되는 순서의 것으로 한다
                sPicPath = sPath & iNextPic & ".jpg"
                Exit For
            End If
        Next
    End If
    
   If Not picBox.Picture Is Nothing Then
        If MsgBox(sPicPath & " 그림화일을 " & vbNewLine & _
                        sImage & " 로 바꾸시겠습니까?", vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
	'' jpg확장자 그림화일만 휠터링되게 한다
    sImage = Application.GetOpenFilename("그림화일 (*.jpg), *.jpg")
    If sImage <> "" Then
        picBox.Picture = LoadPicture(sImage)
    Else
        Exit Sub
    End If

MOVE_PIC:
    VBA.FileSystem.FileCopy sImage, sPicPath
Else
    MsgBox "요청서탭을 선택후 하세요"
End If

End Sub

그림관련 콘트롤몇개를 이용하여..
그림화일을 요청서별로 쉽게 관찰할수 있고, 관리할수 있는 좋은 시스템이 된 셈이다


다음 선택된 탭에 따라 해당요청서에 내용을 작성하고 볼수 있는
[미리보기]버튼을 크릭하면
요청서번호에 해당하는 선택된 탭의 캡션값으로 해당요청서의 행범위를 찾아서
이 행범위의 각각의 값을 요청서의 각 지정된 셀에 값을 옮긴다

그림 화일을 각각의 위치에 배치하는것을 잘 관찰하시기를..

Private Sub btnPreview_Click()
On Error Resume Next
Dim iIndex As Integer
Dim rCurrentRow As Range
Dim rTable As Range
Dim shtRequest As Worksheet
Dim shtCheckList As Worksheet
Dim rCheckListTable As Range
Dim rCheckListCol As Range
Dim iRow As Integer
Dim shpPic As Shape
Dim shpPicture As Picture

'' 요청서 번호에 해당하는 Tab을 선택하였을때만 작업을 한다
If IsNumeric(sCurrentTab) Then

    '' Tab캡션값에서 몇번째요청서 인지 알아낸다
    iIndex = Val(sCurrentTab)
    '' 해당 요청서행을 찾는다
    Set rCurrentRow = modMain.shtCurrentList.Rows(iIndex + 1)
    '' 요청서목록 테이블
    Set rTable = rCurrentRow.CurrentRegion
    '' 요청서 시트
    Set shtRequest = Worksheets(modMain.REQUEST_SHEET)
    '' 체크리스트시트
    Set shtCheckList = Worksheets(modMain.CHECK_LIST_SHEET)
    '' 체크리스트목록범위
    Set rCheckListTable = shtCheckList.Range("A1").CurrentRegion
    
    '' 요청서시트로 이동하기 위하여 RequestSheet버튼이벤트프시져를 호출한다
    btnRequestSheet_Click
        
    For Each shpPic In shtRequest.Shapes
    '' 이전 사진들 삭제하기
        If shpPic.AutoShapeType = 1 Then '' 버튼은 삭제하지 못하게
            shpPic.Delete
        End If
    Next
    
    Dim varAdd As Variant
    Dim sDetailWork As String
    Dim rX As Range
    '' 요청서의 각각의 값이 들어갈 셀들을 상수에서 읽어서 값을 옮긴다
    
    '' 세부공종
    sDetailWork = rCurrentRow.Cells(8)
    With shtRequest
        .Range(modMain.문서번호) = rCurrentRow.Cells(4)
        '' 검측위치
        For Each varAdd In Split(modMain.검측위치, ",")
            .Range(CStr(varAdd)) = rCurrentRow.Cells(5)
        Next
        ''세부공종
        For Each varAdd In Split(modMain.세부공종, ",")
            .Range(CStr(varAdd)) = sDetailWork
        Next
        ''검측부위
        .Range(modMain.검측부위) = rCurrentRow.Cells(9)
         ''검측요구일시
        For Each varAdd In Split(modMain.검측요구일시, ",")
            .Range(CStr(varAdd)) = rCurrentRow.Cells(3)
        Next
        '검측사항_1
        .Range(modMain.검측사항_1) = rCurrentRow.Cells(10)
        '대공종
        .Range(modMain.대공종) = rCurrentRow.Cells(6)
         ''검측위치_검측부위
        For Each varAdd In Split(modMain.검측위치_검측부위, ",")
            .Range(CStr(varAdd)) = rCurrentRow.Cells(5) & "/" & rCurrentRow.Cells(9)
        Next
         ''공구구분
        For Each varAdd In Split(modMain.공구구분, ",")
            .Range(CStr(varAdd)) = rCurrentRow.Cells(11)
        Next
         ''시공업체
        For Each varAdd In Split(modMain.시공업체, ",")
            .Range(CStr(varAdd)) = rCurrentRow.Cells(12)
        Next
        
        
         ''검사항목, 목록
        Set rCheckListCol = rCheckListTable.Rows(1).Find(sDetailWork, , , xlWhole)
        Set rCheckListCol = Intersect(rCheckListTable, rCheckListCol.EntireColumn).Offset(1).Resize(rCheckListTable.Rows.Count - 1)
    
        If Not rCheckListCol Is Nothing Then
           
            With .Range(modMain.검사항목)
            .Resize(19, 11).ClearContents
                For Each rX In rCheckListCol.Cells
                    If rX <> "" Then
                        .Offset(iRow) = rX
                        If iRow < 7 Then
                            .Offset(iRow, 1) = rX.Offset(, 1)
                        Else
                            .Offset(iRow, 1) = "시방서 또는 도면"
                        End If
                        iRow = iRow + 1
                    End If
                Next
            End With
            
        End If
        
        '' 그림화일
        'Public Const 사진 As String = "b107,b122,b141,b156"
        Dim sPic As String
        iIndex = 0
        For Each varAdd In Split(modMain.사진, ",")
            iIndex = iIndex + 1
            sPic = ThisWorkbook.Path & "\pics\" & modMain.shtCurrentList.Name & "_" & Val(sCurrentTab) & "_" & iIndex & ".jpg"
            If Dir(sPic) <> "" Then
                shtRequest.Pictures.Insert(sPic).Select
                Set shpPicture = Selection
                With .Range(CStr(varAdd)).Resize(13, 10)
                    shpPicture.Left = .Left + (.Width - shpPicture.Width) / 2
                    shpPicture.Top = .Top + (.Height - shpPicture.Height) / 2
                End With
            End If
        Next
    End With
Else
    MsgBox "요청서탭을 선택후 하세요"
End If
End Sub

실행해보면 항상 문제가 발생할수 있는 것이 프로그래밍이다
사진의 규격이 제멋대로 준비가 될수 있는 것이 실제상황이다
그림이 UserForm의 Image콘트롤의 규격보다 큰 경우 사진이 짤린다
이럴때는 Image콘트롤을 생성할때, 속성을 하나 더 건드려 주면 된다

Set picBox = Me.Controls.Add("Forms.Image.1", "myImage")
picBox.Left = 6
picBox.Width = lstList.Width - 120
picBox.Top = picScrollBar.Top + 15
picBox.Height = 200
picBox.PictureSizeMode = fmPictureSizeModeStretch

PictureSizeMode는 3가지가 있으므로,
실행해보면서 3가지를 모두 사용하면서 상황에 맞추면 될 것이다

이와 같은 문제는 워크시트의 요청서의 그림이 들어갈 범위보다 그림이 작다면
별문제가 없는데 크다면 , 어떤 조치를 취해줘야할 것이다
그림의 사이즈가 범위보다 크다면 메시지 박스를 띄워서 사용할수 없는 규격이라고 하던가
친절하게 그림을 범위에 맞게 조정을 해주던가 , 둘중의 하나다

Dim sPic As String
Dim iWidth As Integer
Dim iHeight As Integer

iIndex = 0
For Each varAdd In Split(modMain.사진, ",")
	iIndex = iIndex + 1
	sPic = ThisWorkbook.Path & "\pics\" & modMain.shtCurrentList.Name & "_" & Val(sCurrentTab) & "_" & iIndex & ".jpg"
	If Dir(sPic) <> "" Then
		shtRequest.Pictures.Insert(sPic).Select
		
		Set shpPicture = Selection
		'' 사진의 높이나 폭이 범위보다 크면
		'' 사진의 높이나 폭을 범위에 맞게 줄이고
		'' 폭과 높이의 비율을 사진의 본래비율을 유지하게 한다
		iWidth = shpPicture.Width
		iHeight = shpPicture.Height
		With .Range(CStr(varAdd)).Resize(13, 10)
			If iWidth > .Width Then
				shpPicture.Width = .Width - 20
				shpPicture.Height = shpPicture.Height * (shpPicture.Width / iWidth)
			ElseIf iHeight > .Height Then
				shpPicture.Height = .Height - 20
				shpPicture.Width = shpPicture.Height * (shpPicture.Height / iHeight)
			End If
			shpPicture.Left = .Left + (.Width - shpPicture.Width) / 2
			shpPicture.Top = .Top + (.Height - shpPicture.Height) / 2
			
		End With
	End If
Next

다음은
[문서변환]버튼을 크릭하면 실행되는 프로시져
여러개의 요청서를 목록상자를 순환하면서 찾아서 , 해당 요청서를
미리보기로 변환후 해당 요청서를 엑셀화일로 저장하기

Private Sub btnToBook_Click()
Dim sFolderPath As String
Dim sFileName As String
Dim iIndex As Integer
Dim oFiles  As New Collection
Dim iOld As Integer
Dim iNew As Integer
Dim varX As Variant
Dim sFiles As String


On Error Resume Next
sFolderPath = ThisWorkbook.Path & "\" & FILE_FOLDER & "\"
'' 목록상자를 순환하면서 체크한것을 찾아서
'' 집합체에 담는다
For iIndex = 0 To Me.lstList.ListCount - 1
    If Me.lstList.Selected(iIndex) Then
        sFileName = modMain.shtCurrentList.Name & "_" & iIndex + 1 & ".xls"

''혹시 이미 같은 이름으로 저장된 것을 표시한다		
        If Dir(sFileName) <> "" Then
            oFiles.Add iIndex + 1 & "|" & sFileName & "|기존"
            iOld = iOld + 1
        Else
            oFiles.Add iIndex + 1 & "|" & sFileName & "|신규"
            iNew = iNew + 1
        End If
    End If
Next
''하나도 체크된 것이 없으면 작업취소..아웃
If iOld = 0 And iNew = 0 Then MsgBox "선택을 하시고 하세요": Exit Sub
''선택된 요청서목록을 문자열로 바꿔서 메시지 박스에 띄워서 알린다
For Each varX In oFiles
    sFiles = sFiles & CStr(varX) & vbNewLine
Next
sFiles = "화일명 뒤의 [기존]표시는 이미 저장된 것입니다" & vbNewLine & _
        "저장하시면 덮어쓰기가 됩니다, 그래도 하시겠습니까?" & vbNewLine & vbNewLine & _
        sFiles
        
Dim oBook As Workbook
Dim oSheet As Worksheet
Dim shpX As Shape
''사용자에게 선택된 내용을 저장하겠느냐, 중복되는 것은 덮어쓰기를 한다..그래도 하겠냐 확인후..
If MsgBox(sFiles, vbYesNo) = vbYes Then
Application.DisplayAlerts = False
'' 요청서시트를 통합문서로 만들어서 저장
For Each varX In oFiles
    sCurrentTab = Split(CStr(varX), "|")(0)
''현재 요청서로 데이타갱신	//////////////////////
	btnPreview_Click
''///////////////////////////////////
    Worksheets(modMain.REQUEST_SHEET).Copy
    Set oBook = ActiveWorkbook
    Set oSheet = ActiveSheet
    For Each shpX In oSheet.Shapes
        If shpX.AutoShapeType = -2 Then
            shpX.Delete
        End If
    Next
    oBook.Close True, sFolderPath & Split(CStr(varX), "|")(1)

Next
Application.DisplayAlerts = True
End If
End Sub



다음은 [PDF] 화일로 저장히기 버튼 크릭
통합문서로 저장하는 것과 거의 같아서 통합문서와 PDF작업을 하나의 프로시져로 하고
매개변수를 달리 주도록 하는 것이 바른 방법이지만,
여기에서는 그냥 중복되더라도 그냥 PDF를 별도의 프로시져로 작성하자
여러분들은 두개를 합쳐서 하나의 프로시져로 하셔도 좋을 것이다

Private Sub btnPDF_Click()
Dim sFolderPath As String
Dim sFileName As String
Dim iIndex As Integer
Dim oFiles  As New Collection
Dim iOld As Integer
Dim iNew As Integer
Dim varX As Variant
Dim sFiles As String

On Error Resume Next
sFolderPath = ThisWorkbook.Path & "\" & FILE_FOLDER & "\"

For iIndex = 0 To Me.lstList.ListCount - 1
    If Me.lstList.Selected(iIndex) Then
        sFileName = modMain.shtCurrentList.Name & "_" & iIndex + 1 & ".pdf"
        If Dir(sFileName) <> "" Then
            oFiles.Add iIndex + 1 & "|" & sFileName & "|기존"
            iOld = iOld + 1
        Else
            oFiles.Add iIndex + 1 & "|" & sFileName & "|신규"
            iNew = iNew + 1
        End If
    End If
Next
If iOld = 0 And iNew = 0 Then MsgBox "선택을 하시고 하세요": Exit Sub
For Each varX In oFiles
    sFiles = sFiles & CStr(varX) & vbNewLine
Next
sFiles = "화일명 뒤의 [기존]표시는 이미 저장된 것입니다" & vbNewLine & _
        "저장하시면 덮어쓰기가 됩니다, 그래도 하시겠습니까?" & vbNewLine & vbNewLine & _
        sFiles
        
Dim oBook As Workbook
Dim oSheet As Worksheet
Dim shpX As Shape

If MsgBox(sFiles, vbYesNo) = vbYes Then
Application.DisplayAlerts = False
sCalledBy = "PDF"
For Each varX In oFiles
    sCurrentTab = Split(CStr(varX), "|")(0)
    btnPreview_Click
    Worksheets(modMain.REQUEST_SHEET).Copy
    Set oBook = ActiveWorkbook
    Set oSheet = ActiveSheet
    For Each shpX In oSheet.Shapes
        If shpX.AutoShapeType = -2 Then
            shpX.Delete
        End If
Next
    
'' pdf 화일을 웹페이지로 게시하지 않고 곧장 저장으로 하는 경우는
'' openAfterPublish 매개변수를 False로 한다
'' 아래는 웹페이지로 보면서 저장이 된다
  oBook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFolderPath & Split(CStr(varX), "|")(1), Quality:=xlQualityStandard, openAfterPublish:=True ' false
  
  '' 화일이 닫히면서 폼이 이벤트가 발생방지를 위하여 요청서페이지를 유지..
  ThisWorkbook.Worksheets(modMain.REQUEST_SHEET).Activate
  '' 그리고 새로만든 문서를 닫는다
  oBook.Close False
Next
sCalledBy = ""
Application.DisplayAlerts = True
End If

End Sub

아래 화일의 코드는 위의 내용과 다르게 수정된 것들이 있으니
잘 살펴보시고..
[출력]부분도 포함되었으나, 현장의 출력장비와 비교하면서 수정하셔야 할것입니다

***[LOG-IN]***