Option Explicit ' ========================================================================= ' 페이지 보기는 Windows API 없이 작성창을 작은 복귀 버튼으로 접는 방식입니다. ' ========================================================================= ' ========================================================================= ' 1. UI 컨트롤 선언 (이벤트 핸들링용) ' ========================================================================= Private mpMain As MSForms.MultiPage Private pgWrite As MSForms.Page Private pgSettings As MSForms.Page ' [작성 페이지 컨트롤 변수 선언] Private lblSearch As MSForms.Label Private lblPhrase As MSForms.Label Private lblDate As MSForms.Label Private lblRank As MSForms.Label Private lblName As MSForms.Label Private lblToken As MSForms.Label Private lblPhraseDetail As MSForms.Label Private lblMemoTitle As MSForms.Label Private lblMemoTime As MSForms.Label Private lblMemoInmate As MSForms.Label Private lblMemoPlace As MSForms.Label Private lblMemoSummary As MSForms.Label Private WithEvents txtBody As MSForms.TextBox Private WithEvents txtReportDate As MSForms.TextBox Private WithEvents txtRank As MSForms.TextBox Private WithEvents txtEmpName As MSForms.TextBox Private WithEvents txtMemoTime1 As MSForms.TextBox Private WithEvents txtMemoTime2 As MSForms.TextBox Private WithEvents txtMemoTime3 As MSForms.TextBox Private WithEvents txtMemoInmate1 As MSForms.TextBox Private WithEvents txtMemoInmate2 As MSForms.TextBox Private WithEvents txtMemoInmate3 As MSForms.TextBox Private WithEvents txtMemoInmate4 As MSForms.TextBox Private WithEvents txtMemoPlace1 As MSForms.TextBox Private WithEvents txtMemoPlace2 As MSForms.TextBox Private WithEvents txtMemoPlace3 As MSForms.TextBox Private WithEvents txtMemoPlace4 As MSForms.TextBox Private WithEvents txtMemoSummary As MSForms.TextBox Private WithEvents txtPhraseSearch As MSForms.TextBox Private WithEvents btnPhraseClear As MSForms.CommandButton Private WithEvents lstPhrases As MSForms.ListBox Private txtPhraseDetail As MSForms.TextBox Private WithEvents btnPhraseInsert As MSForms.CommandButton Private WithEvents btnPhraseDelete As MSForms.CommandButton Private WithEvents btnPhraseTagEdit As MSForms.CommandButton Private WithEvents btnMemoNow As MSForms.CommandButton Private WithEvents btnMemoAppend As MSForms.CommandButton Private WithEvents btnMemoClear As MSForms.CommandButton Private WithEvents chkMemoAutoReplace As MSForms.CheckBox Private WithEvents chkMemoQuickReplace As MSForms.CheckBox Private WithEvents cboTokenType As MSForms.ComboBox Private WithEvents btnInsertToken As MSForms.CommandButton Private WithEvents btnClearBody As MSForms.CommandButton Private WithEvents btnPhraseSave As MSForms.CommandButton Private WithEvents btnGenerate As MSForms.CommandButton Private WithEvents btnPrint As MSForms.CommandButton Private WithEvents btnToggleTransparent As MSForms.CommandButton Private WithEvents btnToggleTransparentSettings As MSForms.CommandButton Private WithEvents btnPageViewReturn As MSForms.CommandButton ' [설정 페이지 컨트롤 변수 선언] Private lblDocTitle As MSForms.Label Private lblOrg As MSForms.Label Private lblPath As MSForms.Label Private lblTSize As MSForms.Label Private lblBSize As MSForms.Label Private lblDSize As MSForms.Label Private lblOSize As MSForms.Label Private lblSpaceTB As MSForms.Label Private lblSpaceBD As MSForms.Label Private lblSpaceDS As MSForms.Label Private lblSpaceSO As MSForms.Label Private lblTitleSpc As MSForms.Label Private lblOrgSpc As MSForms.Label Private lblOptionTitle As MSForms.Label Private lblDefaultLocation As MSForms.Label Private lblTitleFont As MSForms.Label Private lblBodyFont As MSForms.Label Private lblDateFont As MSForms.Label Private lblOrgFont As MSForms.Label Private lblInfo As MSForms.Label Private WithEvents txtDocTitle As MSForms.TextBox Private WithEvents txtOrgName As MSForms.TextBox Private txtSavePath As MSForms.TextBox Private WithEvents btnSelectPath As MSForms.CommandButton Private WithEvents txtTitleSize As MSForms.TextBox Private WithEvents txtBodySize As MSForms.TextBox Private WithEvents txtDateSize As MSForms.TextBox Private WithEvents txtOrgSize As MSForms.TextBox Private WithEvents txtSpaceTB As MSForms.TextBox Private WithEvents txtSpaceBD As MSForms.TextBox Private WithEvents txtSpaceDS As MSForms.TextBox Private WithEvents txtSpaceSO As MSForms.TextBox Private WithEvents txtTitleSpacing As MSForms.TextBox Private WithEvents txtOrgSpacing As MSForms.TextBox Private WithEvents chkAutoDateTime As MSForms.CheckBox Private WithEvents txtDefaultLocation As MSForms.TextBox Private WithEvents txtTitleFontName As MSForms.TextBox Private WithEvents txtBodyFontName As MSForms.TextBox Private WithEvents txtDateFontName As MSForms.TextBox Private WithEvents txtOrgFontName As MSForms.TextBox Private WithEvents chkTitleBold As MSForms.CheckBox Private WithEvents chkBodyBold As MSForms.CheckBox Private WithEvents chkDateBold As MSForms.CheckBox Private WithEvents chkOrgBold As MSForms.CheckBox Private WithEvents btnSaveSettings As MSForms.CommandButton Private WithEvents btnPullPreviewSettings As MSForms.CommandButton Private lblCreator As MSForms.Label ' 데이터 메모리 Private phraseList As String Private tagList As String Private Const DELIM As String = "|||" Private Const PREVIEW_BOOKMARK As String = "LiveReportPreview" Private isPreviewUpdating As Boolean Private isLayoutInitializing As Boolean Private isTransparent As Boolean Private isQuickReplacing As Boolean Private isPhraseSuggestMode As Boolean Private isPhraseSuggestPreviewing As Boolean Private phraseSuggestStart As Long Private phraseSuggestLength As Long Private phraseSuggestOriginal As String Private phraseSuggestOriginalLength As Long Private phraseSuggestSearchBackup As String Private phraseSuggestListIndexBackup As Long Private savedFormLeft As Single Private savedFormTop As Single Private savedFormWidth As Single Private savedFormHeight As Single Private savedFormBoundsReady As Boolean Private lastBodyCaretLogicalPos As Long ' ========================================================================= ' 2. 폼 초기화 및 화면 빌드 ' ========================================================================= Private Sub UserForm_Initialize() BuildUI LoadData RefreshPhraseList End Sub Private Sub BuildUI() Me.caption = "근무보고서 텍스트 생성기" Me.Width = 1000 Me.Height = 790 Me.StartUpPosition = 1 Set btnPageViewReturn = AddButton(Me, "btnPageViewReturn", "작성창 복귀", 12, 12, 120, 28) btnPageViewReturn.Visible = False btnPageViewReturn.ControlTipText = "보고서 작성창을 다시 펼칩니다." Set mpMain = Me.Controls.Add("Forms.MultiPage.1", "mpMain", True) mpMain.Move 10, 10, 960, 730 mpMain.Font.Size = 11 Set pgWrite = mpMain.Pages(0) Set pgSettings = mpMain.Pages(1) pgWrite.caption = "보고서 작성" pgSettings.caption = "환경 설정" ' --------------------------------------------------------- ' [작성 페이지] 좌측 (구문 목록창 세로로 시원하게 확대) ' --------------------------------------------------------- Set lblSearch = AddLabel(pgWrite, "lblSearch", "구문/태그 검색:", 15, 20) Set txtPhraseSearch = AddTextBox(pgWrite, "txtPhraseSearch", "", 125, 16, 115, 24) txtPhraseSearch.ControlTipText = "구문이나 태그를 검색합니다. 본문에서 //검색어 입력 후 Enter를 누르면 이 검색칸과 구문목록이 추천 목록으로 바뀝니다." Set btnPhraseClear = AddButton(pgWrite, "btnPhraseClear", "초기화", 245, 15, 55, 26) Set lblPhrase = AddLabel(pgWrite, "lblPhrase", "자주 쓰는 구문 목록 (더블클릭 삽입)", 15, 55) Set lstPhrases = pgWrite.Controls.Add("Forms.ListBox.1", "lstPhrases", True) lstPhrases.Move 15, 80, 285, 235 lstPhrases.Font.name = ChrW$(&HB9D1) & ChrW$(&HC740) & " " & ChrW$(&HACE0) & ChrW$(&HB515) lstPhrases.Font.Size = 13 lstPhrases.ControlTipText = "//검색어 추천 중에는 ↑↓로 미리보기, Enter로 확정, Esc로 취소합니다. 평소에는 더블클릭으로 삽입합니다." Set btnPhraseInsert = AddButton(pgWrite, "btnPhraseInsert", CaptionPhraseInsert(), 15, 325, 90, 30) Set btnPhraseTagEdit = AddButton(pgWrite, "btnPhraseTagEdit", CaptionPhraseTagEdit(), 112, 325, 90, 30) Set btnPhraseDelete = AddButton(pgWrite, "btnPhraseDelete", CaptionPhraseDelete(), 210, 325, 90, 30) Set lblMemoTitle = AddLabel(pgWrite, "lblMemoTitle", "상황 간단 메모", 15, 365) lblMemoTitle.ForeColor = RGB(0, 102, 204) lblMemoTitle.Font.Bold = True Set chkMemoAutoReplace = pgWrite.Controls.Add("Forms.CheckBox.1", "chkMemoAutoReplace", True) chkMemoAutoReplace.caption = "토큰 기본값 자동입력(1번 우선)" chkMemoAutoReplace.Move 128, 362, 170, 22 chkMemoAutoReplace.Font.name = "맑은 고딕" chkMemoAutoReplace.Font.Size = 9 chkMemoAutoReplace.value = True chkMemoAutoReplace.ControlTipText = "구문 삽입 중 {{시각1}}, {{장소1}}, {{수용자1:이/가}} 같은 토큰이 나오면 메모 1번 값을 기본값으로 먼저 보여줍니다. 번호가 2~4면 해당 번호 값을 사용합니다." Set lblMemoTime = AddLabel(pgWrite, "lblMemoTime", "시각1~3", 15, 392) Set txtMemoTime1 = AddTextBox(pgWrite, "txtMemoTime1", "", 52, 387, 76, 21) Set txtMemoTime2 = AddTextBox(pgWrite, "txtMemoTime2", "", 132, 387, 76, 21) Set txtMemoTime3 = AddTextBox(pgWrite, "txtMemoTime3", "", 212, 387, 76, 21) txtMemoTime1.Font.Size = 9 txtMemoTime1.BackColor = RGB(255, 250, 210) txtMemoTime1.ControlTipText = "가장 자주 쓰는 시각 1번입니다. {{시각1}} 또는 /시각1의 기본값으로 먼저 사용됩니다." txtMemoTime2.Font.Size = 9 txtMemoTime3.Font.Size = 9 Set btnMemoNow = AddButton(pgWrite, "btnMemoNow", "현재", 15, 414, 48, 23) Set lblMemoInmate = AddLabel(pgWrite, "lblMemoInmate", "수용자1~4", 15, 445) Set txtMemoInmate1 = AddTextBox(pgWrite, "txtMemoInmate1", "", 64, 440, 100, 21) Set txtMemoInmate2 = AddTextBox(pgWrite, "txtMemoInmate2", "", 180, 440, 100, 21) Set txtMemoInmate3 = AddTextBox(pgWrite, "txtMemoInmate3", "", 64, 465, 100, 21) Set txtMemoInmate4 = AddTextBox(pgWrite, "txtMemoInmate4", "", 180, 465, 100, 21) txtMemoInmate1.Font.Size = 9 txtMemoInmate1.BackColor = RGB(255, 250, 210) txtMemoInmate1.ControlTipText = "가장 자주 쓰는 수용자 1번입니다. {{수용자1:이/가}} 또는 /수용자1의 기본값으로 먼저 사용됩니다." txtMemoInmate2.Font.Size = 9 txtMemoInmate3.Font.Size = 9 txtMemoInmate4.Font.Size = 9 Set lblMemoPlace = AddLabel(pgWrite, "lblMemoPlace", "장소1~4", 15, 497) Set txtMemoPlace1 = AddTextBox(pgWrite, "txtMemoPlace1", "", 64, 492, 100, 21) Set txtMemoPlace2 = AddTextBox(pgWrite, "txtMemoPlace2", "", 180, 492, 100, 21) Set txtMemoPlace3 = AddTextBox(pgWrite, "txtMemoPlace3", "", 64, 517, 100, 21) Set txtMemoPlace4 = AddTextBox(pgWrite, "txtMemoPlace4", "", 180, 517, 100, 21) txtMemoPlace1.Font.Size = 9 txtMemoPlace1.BackColor = RGB(255, 250, 210) txtMemoPlace1.ControlTipText = "가장 자주 쓰는 장소 1번입니다. {{장소1}} 또는 /장소1의 기본값으로 먼저 사용됩니다." txtMemoPlace2.Font.Size = 9 txtMemoPlace3.Font.Size = 9 txtMemoPlace4.Font.Size = 9 Set lblMemoSummary = AddLabel(pgWrite, "lblMemoSummary", "요약", 15, 552) Set txtMemoSummary = AddTextBox(pgWrite, "txtMemoSummary", "", 64, 545, 216, 70, True) txtMemoSummary.Font.Size = 10 Set btnMemoAppend = AddButton(pgWrite, "btnMemoAppend", "선택위치 입력", 15, 625, 135, 28) btnMemoAppend.ControlTipText = "본문창에서 커서를 둔 곳에 메모 내용을 넣거나, 드래그 선택한 문구를 메모 내용으로 바꿉니다." Set btnMemoClear = AddButton(pgWrite, "btnMemoClear", "메모 비우기", 160, 625, 135, 28) btnMemoClear.ControlTipText = "시각, 수용자, 장소, 요약 메모칸을 모두 비웁니다." Set chkMemoQuickReplace = pgWrite.Controls.Add("Forms.CheckBox.1", "chkMemoQuickReplace", True) chkMemoQuickReplace.caption = "본문 /단축치환" chkMemoQuickReplace.Move 15, 662, 135, 22 chkMemoQuickReplace.Font.name = "맑은 고딕" chkMemoQuickReplace.Font.Size = 9 chkMemoQuickReplace.value = True chkMemoQuickReplace.ControlTipText = "본문에 /시각1, /시간1, /장소1, /수용자1처럼 번호까지 입력하면 메모값으로 바로 바뀝니다. /시각처럼 번호가 없으면 치환하지 않습니다." ' --------------------------------------------------------- ' [작성 페이지] 우측 (예시창 상단 배치 및 본문 공간 분할) ' --------------------------------------------------------- Set lblDate = AddLabel(pgWrite, "lblDate", "작성일:", 325, 20) Set txtReportDate = AddTextBox(pgWrite, "txtReportDate", Format(Date, "yyyy.mm.dd") & "(" & WeekdayName(Weekday(Date), True) & ")", 380, 16, 110, 24) Set lblRank = AddLabel(pgWrite, "lblRank", "직급:", 505, 20) Set txtRank = AddTextBox(pgWrite, "txtRank", "교도", 545, 16, 50, 24) Set lblName = AddLabel(pgWrite, "lblName", "성명:", 610, 20) Set txtEmpName = AddTextBox(pgWrite, "txtEmpName", "", 655, 16, 100, 24) Set btnToggleTransparent = AddButton(pgWrite, "btnToggleTransparent", "페이지 보기", 785, 15, 125, 26) btnToggleTransparent.ControlTipText = "현재 내용을 페이지에 반영한 뒤 작성창을 작은 복귀 버튼으로 접어 Word 페이지를 보고 스크롤할 수 있게 합니다." ' ★ 예시창은 읽기 편한 작은 글씨로 선택 구문을 보여주되, 본문 공간을 침범하지 않게 조정 Set lblPhraseDetail = AddLabel(pgWrite, "lblPhraseDetail", "선택된 구문 전체 보기 (작성 시 예시로 참고):", 325, 60) lblPhraseDetail.ForeColor = RGB(0, 102, 204) Set txtPhraseDetail = AddTextBox(pgWrite, "txtPhraseDetail", "", 325, 85, 615, 205, True) txtPhraseDetail.Font.Size = 10.5 ' 50대 사용자가 읽기 편한 크기보다 살짝 작게 조정 txtPhraseDetail.Locked = True txtPhraseDetail.BackColor = RGB(245, 250, 255) ' 시원한 파스텔 배경 txtPhraseDetail.BorderStyle = 1 ' 본문 조작 툴줄 Set lblToken = AddLabel(pgWrite, "lblToken", "템플릿 토큰 삽입:", 325, 315) Set cboTokenType = pgWrite.Controls.Add("Forms.ComboBox.1", "cboTokenType", True) cboTokenType.Move 445, 311, 125, 24 cboTokenType.Font.name = "맑은 고딕": cboTokenType.Font.Size = 11 cboTokenType.List = Array("시각", "시각1", "시각2", "시각3", "장소", "장소1", "장소2", "장소3", "장소4", "발생장소1", "수용자", "수용자1:이/가", "수용자2:이/가", "수용자3:이/가", "수용자4:이/가", "당사자1:이/가", "사유") cboTokenType.ListIndex = 0 Set btnInsertToken = AddButton(pgWrite, "btnInsertToken", "삽입", 575, 310, 55, 26) Set btnClearBody = AddButton(pgWrite, "btnClearBody", "본문 비우기", 640, 310, 85, 26) Set btnPhraseSave = AddButton(pgWrite, "btnPhraseSave", "현재 본문을 구문 저장", 735, 310, 205, 26) ' 본문창은 50대 사용자도 편하게 읽을 수 있는 글자 크기를 유지하면서 줄 수를 최대한 확보 Set txtBody = AddTextBox(pgWrite, "txtBody", "", 325, 345, 615, 270, True) txtBody.Font.Size = 14 txtBody.HideSelection = False Set btnGenerate = AddButton(pgWrite, "btnGenerate", "보고서 파일 생성", 325, 650, 300, 40) Set btnPrint = AddButton(pgWrite, "btnPrint", "보고서 즉시 인쇄", 640, 650, 300, 40) btnGenerate.BackColor = RGB(220, 230, 245) btnPrint.BackColor = RGB(245, 220, 220) ' --------------------------------------------------------- ' [설정 페이지] 가림 현상 없는 3열 격자형 깔끔한 배치 ' --------------------------------------------------------- Set lblInfo = pgSettings.Controls.Add("Forms.Label.1", "lblInfo", True) lblInfo.caption = "※ 페이지 보기: 현재 내용을 문서에 반영하고 작성창을 접어 확인/스크롤합니다. 복귀 시 본문/설정값을 다시 가져옵니다." & vbCrLf & _ "※ /시각1·/장소1·/수용자1=메모 치환, //검색어+Enter=왼쪽 구문목록 추천. 크기/간격은 기본 배치값이며, 페이지에서 조정한 문단 서식은 작성창 복귀 때 최대한 반영됩니다." lblInfo.Move 20, 20, 750, 35 lblInfo.Font.name = "맑은 고딕": lblInfo.Font.Size = 10 lblInfo.WordWrap = True lblInfo.ForeColor = RGB(0, 102, 204) ' [1열] 문서 정보 Set lblDocTitle = AddLabel(pgSettings, "lblDocTitle", "보고서 제목 (예: 근무보고서):", 20, 75) Set txtDocTitle = AddTextBox(pgSettings, "txtDocTitle", DefaultDocTitle(), 20, 95, 280, 24) Set lblOrg = AddLabel(pgSettings, "lblOrg", "기관명 (예: 안양교도소장귀하):", 20, 135) Set txtOrgName = AddTextBox(pgSettings, "txtOrgName", "안양교도소장귀하", 20, 155, 280, 24) Set lblPath = AddLabel(pgSettings, "lblPath", "파일 생성 폴더 위치:", 20, 195) Set txtSavePath = AddTextBox(pgSettings, "txtSavePath", "", 20, 215, 280, 24) Set btnSelectPath = AddButton(pgSettings, "btnSelectPath", "폴더 선택", 210, 245, 90, 28) ' [2열] 크기 및 간격 설정 Set lblTSize = AddLabel(pgSettings, "lblTSize", "제목 크기:", 330, 75) Set txtTitleSize = AddTextBox(pgSettings, "txtTitleSize", "34", 405, 71, 35, 24) txtTitleSize.ControlTipText = "보고서 제목 글자 크기입니다. 숫자가 클수록 크게 보입니다." Set lblTitleSpc = AddLabel(pgSettings, "lblTitleSpc", "제목 자간:", 455, 75) Set txtTitleSpacing = AddTextBox(pgSettings, "txtTitleSpacing", "7", 530, 71, 35, 24) txtTitleSpacing.ControlTipText = "제목 글자 사이 간격입니다. 숫자가 클수록 글자가 넓게 벌어집니다." Set lblBSize = AddLabel(pgSettings, "lblBSize", "본문 크기:", 330, 115) Set txtBodySize = AddTextBox(pgSettings, "txtBodySize", "14", 405, 111, 35, 24) txtBodySize.ControlTipText = "본문 글자 크기입니다. 숫자가 클수록 크게 보입니다." Set lblDSize = AddLabel(pgSettings, "lblDSize", "날짜 크기:", 330, 155) Set txtDateSize = AddTextBox(pgSettings, "txtDateSize", "16", 405, 151, 35, 24) txtDateSize.ControlTipText = "작성일과 서명 부분의 글자 크기입니다." Set lblOSize = AddLabel(pgSettings, "lblOSize", "기관 크기:", 330, 195) Set txtOrgSize = AddTextBox(pgSettings, "txtOrgSize", "42", 405, 191, 35, 24) txtOrgSize.ControlTipText = "하단 기관명 글자 크기입니다." Set lblOrgSpc = AddLabel(pgSettings, "lblOrgSpc", "기관 자간:", 455, 195) Set txtOrgSpacing = AddTextBox(pgSettings, "txtOrgSpacing", "7", 530, 191, 35, 24) txtOrgSpacing.ControlTipText = "기관명 글자 사이 간격입니다." Set lblSpaceTB = AddLabel(pgSettings, "lblSpaceTB", "간격(제-본):", 330, 245) Set txtSpaceTB = AddTextBox(pgSettings, "txtSpaceTB", "1", 415, 241, 35, 24) txtSpaceTB.ControlTipText = "제목과 본문 사이에 넣을 빈 줄 수입니다." Set lblSpaceBD = AddLabel(pgSettings, "lblSpaceBD", "간격(본-날):", 330, 285) Set txtSpaceBD = AddTextBox(pgSettings, "txtSpaceBD", "3", 415, 281, 35, 24) txtSpaceBD.ControlTipText = "본문과 작성일 사이에 넣을 빈 줄 수입니다." Set lblSpaceDS = AddLabel(pgSettings, "lblSpaceDS", "간격(날-서):", 330, 325) Set txtSpaceDS = AddTextBox(pgSettings, "txtSpaceDS", "0", 415, 321, 35, 24) txtSpaceDS.ControlTipText = "작성일과 서명 사이에 넣을 빈 줄 수입니다." Set lblSpaceSO = AddLabel(pgSettings, "lblSpaceSO", "간격(서-기):", 330, 365) Set txtSpaceSO = AddTextBox(pgSettings, "txtSpaceSO", "2", 415, 361, 35, 24) txtSpaceSO.ControlTipText = "서명과 기관명 사이에 넣을 빈 줄 수입니다." ' [3열] 편의 기능 설정 Set lblOptionTitle = AddLabel(pgSettings, "lblOptionTitle", "[ 편의 기능 옵션 및 기본값 설정 ]", 610, 75) Set chkAutoDateTime = pgSettings.Controls.Add("Forms.CheckBox.1", "chkAutoDateTime", True) chkAutoDateTime.caption = "'시각' 토큰 시 현재 시간 자동 입력" chkAutoDateTime.Move 610, 100, 300, 24 chkAutoDateTime.Font.name = "맑은 고딕": chkAutoDateTime.Font.Size = 11 Set lblDefaultLocation = AddLabel(pgSettings, "lblDefaultLocation", "기본 장소값 (예: 6동 하층, 운동장):", 610, 145) Set txtDefaultLocation = AddTextBox(pgSettings, "txtDefaultLocation", "6동", 610, 165, 280, 24) Set lblTitleFont = AddLabel(pgSettings, "lblTitleFont", "제목 글씨체:", 610, 205) Set txtTitleFontName = AddTextBox(pgSettings, "txtTitleFontName", "Batang", 705, 201, 115, 24) txtTitleFontName.ControlTipText = "보고서 제목에 적용할 글씨체 이름입니다. 예: Batang, 바탕, 맑은 고딕" Set chkTitleBold = pgSettings.Controls.Add("Forms.CheckBox.1", "chkTitleBold", True) chkTitleBold.caption = "진하게" chkTitleBold.Move 825, 202, 70, 22 chkTitleBold.Font.name = "맑은 고딕": chkTitleBold.Font.Size = 9 chkTitleBold.ControlTipText = "보고서 제목을 굵게 출력합니다." Set lblBodyFont = AddLabel(pgSettings, "lblBodyFont", "본문 글씨체:", 610, 235) Set txtBodyFontName = AddTextBox(pgSettings, "txtBodyFontName", "Batang", 705, 231, 115, 24) txtBodyFontName.ControlTipText = "본문에 적용할 글씨체 이름입니다." Set chkBodyBold = pgSettings.Controls.Add("Forms.CheckBox.1", "chkBodyBold", True) chkBodyBold.caption = "진하게" chkBodyBold.Move 825, 232, 70, 22 chkBodyBold.Font.name = "맑은 고딕": chkBodyBold.Font.Size = 9 chkBodyBold.ControlTipText = "본문 문장 전체를 굵게 출력합니다." Set lblDateFont = AddLabel(pgSettings, "lblDateFont", "날짜/서명:", 610, 265) Set txtDateFontName = AddTextBox(pgSettings, "txtDateFontName", "Batang", 705, 261, 115, 24) txtDateFontName.ControlTipText = "작성일과 서명 부분에 적용할 글씨체 이름입니다." Set chkDateBold = pgSettings.Controls.Add("Forms.CheckBox.1", "chkDateBold", True) chkDateBold.caption = "진하게" chkDateBold.Move 825, 262, 70, 22 chkDateBold.Font.name = "맑은 고딕": chkDateBold.Font.Size = 9 chkDateBold.ControlTipText = "작성일과 서명 부분을 굵게 출력합니다." Set lblOrgFont = AddLabel(pgSettings, "lblOrgFont", "기관 글씨체:", 610, 295) Set txtOrgFontName = AddTextBox(pgSettings, "txtOrgFontName", "Batang", 705, 291, 115, 24) txtOrgFontName.ControlTipText = "하단 기관명에 적용할 글씨체 이름입니다." Set chkOrgBold = pgSettings.Controls.Add("Forms.CheckBox.1", "chkOrgBold", True) chkOrgBold.caption = "진하게" chkOrgBold.Move 825, 292, 70, 22 chkOrgBold.Font.name = "맑은 고딕": chkOrgBold.Font.Size = 9 chkOrgBold.ControlTipText = "하단 기관명을 굵게 출력합니다." Set btnToggleTransparentSettings = AddButton(pgSettings, "btnToggleTransparentSettings", "페이지 보기", 785, 15, 125, 26) btnToggleTransparentSettings.ControlTipText = "현재 내용을 페이지에 반영한 뒤 작성창을 작은 복귀 버튼으로 접어 Word 페이지를 보고 스크롤할 수 있게 합니다." Set btnSaveSettings = AddButton(pgSettings, "btnSaveSettings", CaptionSaveSettings(), 20, 600, 180, 40) Set btnPullPreviewSettings = AddButton(pgSettings, "btnPullPreviewSettings", CaptionPullPreviewSettings(), 215, 600, 220, 40) Set lblCreator = pgSettings.Controls.Add("Forms.Label.1", "lblCreator", True) lblCreator.caption = "만든이: leekwangchan" lblCreator.Move 810, 670, 130, 20 lblCreator.Font.name = "맑은 고딕": lblCreator.Font.Size = 8 lblCreator.ForeColor = RGB(150, 150, 150) End Sub ' ========================================================================= ' 4. 데이터 로드 및 호스트 문서 격리 저장 ' ========================================================================= Private Sub LoadData() On Error Resume Next txtDocTitle.text = GetVar("Cfg_DocTitle", DefaultDocTitle()) txtRank.text = GetVar("Cfg_Rank", "교도") txtEmpName.text = GetVar("Cfg_Name", "") txtOrgName.text = GetVar("Cfg_Org", "안양교도소장귀하") txtSavePath.text = GetVar("Cfg_SavePath", Options.DefaultFilePath(wdDocumentsPath)) txtTitleSize.text = GetVar("Cfg_TitleSz", "34") txtBodySize.text = GetVar("Cfg_BodySz", "14") txtDateSize.text = GetVar("Cfg_DateSz", "16") txtOrgSize.text = GetVar("Cfg_OrgSz", "42") txtSpaceTB.text = GetVar("Cfg_SpcTB", "1") txtSpaceBD.text = GetVar("Cfg_SpcBD", "3") txtSpaceDS.text = GetVar("Cfg_SpcDS", "0") txtSpaceSO.text = GetVar("Cfg_SpcSO", "2") txtTitleSpacing.text = GetVar("Cfg_TitleSpc", "7") txtOrgSpacing.text = GetVar("Cfg_OrgSpc", "7") chkAutoDateTime.value = CBool(GetVar("Cfg_AutoDT", "True")) txtDefaultLocation.text = GetVar("Cfg_DefLoc", "6동") txtTitleFontName.text = GetVar("Cfg_TitleFont", GetVar("Cfg_ReportFont", "Batang")) txtBodyFontName.text = GetVar("Cfg_BodyFont", GetVar("Cfg_ReportFont", "Batang")) txtDateFontName.text = GetVar("Cfg_DateFont", GetVar("Cfg_ReportFont", "Batang")) txtOrgFontName.text = GetVar("Cfg_OrgFont", GetVar("Cfg_ReportFont", "Batang")) chkTitleBold.value = CBool(GetVar("Cfg_TitleBold", "True")) chkBodyBold.value = CBool(GetVar("Cfg_BodyBold", "False")) chkDateBold.value = CBool(GetVar("Cfg_DateBold", "False")) chkOrgBold.value = CBool(GetVar("Cfg_OrgBold", "True")) If Not txtMemoPlace1 Is Nothing Then txtMemoPlace1.text = txtDefaultLocation.text phraseList = GetVar("Cfg_Phrases", "저는 6동 근무자로서 {{시각}} 경 {{발생장소}}에서 {{수용자:이/가}} 소란을 피워 동행한 사실이 있습니다.") tagList = GetVar("Cfg_Tags", "기본예시") On Error GoTo 0 End Sub Private Sub SaveData() SetVar "Cfg_DocTitle", Trim(txtDocTitle.text) SetVar "Cfg_Rank", txtRank.text SetVar "Cfg_Name", txtEmpName.text SetVar "Cfg_Org", Replace(txtOrgName.text, " ", "") SetVar "Cfg_SavePath", txtSavePath.text SetVar "Cfg_TitleSz", txtTitleSize.text SetVar "Cfg_BodySz", txtBodySize.text SetVar "Cfg_DateSz", txtDateSize.text SetVar "Cfg_OrgSz", txtOrgSize.text SetVar "Cfg_SpcTB", txtSpaceTB.text SetVar "Cfg_SpcBD", txtSpaceBD.text SetVar "Cfg_SpcDS", txtSpaceDS.text SetVar "Cfg_SpcSO", txtSpaceSO.text SetVar "Cfg_TitleSpc", txtTitleSpacing.text SetVar "Cfg_OrgSpc", txtOrgSpacing.text SetVar "Cfg_AutoDT", CStr(chkAutoDateTime.value) SetVar "Cfg_DefLoc", Trim(txtDefaultLocation.text) SetVar "Cfg_TitleFont", Trim(txtTitleFontName.text) SetVar "Cfg_BodyFont", Trim(txtBodyFontName.text) SetVar "Cfg_DateFont", Trim(txtDateFontName.text) SetVar "Cfg_OrgFont", Trim(txtOrgFontName.text) SetVar "Cfg_TitleBold", CStr(chkTitleBold.value) SetVar "Cfg_BodyBold", CStr(chkBodyBold.value) SetVar "Cfg_DateBold", CStr(chkDateBold.value) SetVar "Cfg_OrgBold", CStr(chkOrgBold.value) SetVar "Cfg_Phrases", phraseList SetVar "Cfg_Tags", tagList End Sub Private Sub SaveHostDocument() On Error Resume Next ThisDocument.Save On Error GoTo 0 End Sub Private Function GetVar(key As String, defaultVal As String) As String On Error Resume Next GetVar = ThisDocument.Variables(key).value If Err.Number <> 0 Then GetVar = defaultVal On Error GoTo 0 End Function Private Sub SetVar(key As String, val As String) On Error Resume Next ThisDocument.Variables.Add name:=key, value:=val ThisDocument.Variables(key).value = val On Error GoTo 0 End Sub ' ========================================================================= ' 5. 구문 리스트 조작 핸들러 ' ========================================================================= Private Sub btnSaveSettings_Click() SaveData MsgBox "환경 설정 내용이 저장되었습니다.", vbInformation End Sub Private Sub btnSelectPath_Click() Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.Title = "보고서를 저장할 폴더를 선택하세요" If fd.Show = -1 Then txtSavePath.text = fd.SelectedItems(1) SaveData End If Set fd = Nothing End Sub Private Sub txtPhraseSearch_Change() RefreshPhraseList End Sub Private Sub btnPhraseClear_Click() If isPhraseSuggestMode Then CancelPhraseSuggestion Exit Sub End If txtPhraseSearch.text = "" RefreshPhraseList End Sub Private Sub RefreshPhraseList() lstPhrases.Clear If phraseList = "" Then Exit Sub Dim pArr() As String pArr = Split(phraseList, DELIM) Dim tArr() As String tArr = Split(tagList, DELIM) If UBound(tArr) < UBound(pArr) Then ReDim Preserve tArr(UBound(pArr)) End If Dim keyword As String keyword = Replace(LCase(txtPhraseSearch.text), " ", "") Dim i As Long For i = LBound(pArr) To UBound(pArr) Dim pText As String pText = pArr(i) Dim tText As String tText = tArr(i) Dim haystack As String haystack = Replace(LCase(pText & tText), " ", "") If keyword = "" Or InStr(haystack, keyword) > 0 Then Dim PreviewText As String PreviewText = Replace(Replace(pText, vbCrLf, " "), vbLf, " ") If Len(PreviewText) > 24 Then PreviewText = left(PreviewText, 22) & "..." End If Dim displayStr As String If Trim(tText) <> "" Then displayStr = (i + 1) & ". [" & tText & "] " & PreviewText Else displayStr = (i + 1) & ". " & PreviewText End If lstPhrases.AddItem displayStr End If Next i End Sub Private Sub btnPhraseSave_Click() Dim newTxt As String newTxt = Trim(txtBody.text) If newTxt = "" Then Exit Sub Dim newTag As String newTag = InputBox("이 구문을 찾기 쉽게 '검색용 태그'를 달아주세요." & vbCrLf & "(예: 폭행, 야간, 비상벨 등 / 비워두어도 됩니다)", "구문 태그 추가") If StrPtr(newTag) = 0 Then Exit Sub If phraseList = "" Then phraseList = newTxt tagList = newTag Else phraseList = phraseList & DELIM & newTxt tagList = tagList & DELIM & newTag End If SaveData RefreshPhraseList MsgBox "구문과 태그가 안전하게 저장되었습니다.", vbInformation End Sub Private Sub UpdatePhraseDetail() On Error Resume Next If txtPhraseDetail Is Nothing Then Exit Sub txtPhraseDetail.text = "" If phraseList = "" Then Exit Sub Dim actualIdx As Long actualIdx = GetActualIndex() If actualIdx = -1 Then Exit Sub Dim pArr() As String Dim tArr() As String pArr = Split(phraseList, DELIM) tArr = Split(tagList, DELIM) If UBound(tArr) < UBound(pArr) Then ReDim Preserve tArr(UBound(pArr)) End If If actualIdx > UBound(pArr) Then Exit Sub ' 전체 내용을 보여줍니다. If Trim(tArr(actualIdx)) <> "" Then txtPhraseDetail.text = "[" & tArr(actualIdx) & "]" & vbCrLf & pArr(actualIdx) Else txtPhraseDetail.text = pArr(actualIdx) End If End Sub Private Function GetActualIndex() As Long If lstPhrases.ListIndex = -1 Then GetActualIndex = -1 Exit Function End If GetActualIndex = val(lstPhrases.List(lstPhrases.ListIndex)) - 1 End Function Private Function TextBoxLogicalText(ByVal value As String) As String TextBoxLogicalText = Replace(Replace(value, vbCrLf, vbCr), vbLf, vbCr) End Function Private Function LogicalTextLength(ByVal value As String) As Long LogicalTextLength = Len(TextBoxLogicalText(value)) End Function Private Function TextBoxLogicalPosition(ByVal value As String, ByVal actualPos As Long) As Long Dim maxPos As Long If actualPos < 0 Then actualPos = 0 maxPos = LogicalTextLength(value) If actualPos > maxPos Then actualPos = maxPos TextBoxLogicalPosition = actualPos End Function Private Function TextBoxActualPosition(ByVal value As String, ByVal logicalPos As Long) As Long Dim maxPos As Long If logicalPos < 0 Then logicalPos = 0 maxPos = LogicalTextLength(value) If logicalPos > maxPos Then logicalPos = maxPos TextBoxActualPosition = logicalPos End Function Private Sub SetBodyLogicalSelection(ByVal logicalStart As Long, ByVal logicalLength As Long) On Error Resume Next If txtBody Is Nothing Then Exit Sub Dim maxLogical As Long Dim logicalEnd As Long Dim actualStart As Long Dim actualEnd As Long maxLogical = LogicalTextLength(txtBody.text) If logicalStart < 0 Then logicalStart = 0 If logicalStart > maxLogical Then logicalStart = maxLogical If logicalLength < 0 Then logicalLength = 0 logicalEnd = logicalStart + logicalLength If logicalEnd > maxLogical Then logicalEnd = maxLogical actualStart = TextBoxActualPosition(txtBody.text, logicalStart) actualEnd = TextBoxActualPosition(txtBody.text, logicalEnd) txtBody.SelStart = actualStart txtBody.SelLength = actualEnd - actualStart On Error GoTo 0 End Sub Private Function TryStartPhraseSuggestionFromBody() As Boolean On Error GoTo SuggestError If phraseList = "" Then Exit Function If txtBody.SelLength <> 0 Then Exit Function Dim cursorPos As Long Dim normalizedText As String Dim beforeCursor As String Dim triggerPos As Long Dim keyword As String normalizedText = TextBoxLogicalText(txtBody.text) cursorPos = TextBoxLogicalPosition(txtBody.text, txtBody.SelStart) If cursorPos > Len(normalizedText) Then cursorPos = Len(normalizedText) beforeCursor = left(normalizedText, cursorPos) triggerPos = InStrRev(beforeCursor, "//") If triggerPos = 0 Then Exit Function keyword = Mid(beforeCursor, triggerPos + 2) If Trim(keyword) = "" Then Exit Function If InStr(keyword, vbCr) > 0 Then Exit Function If InStr(keyword, " ") > 0 Then Exit Function If InStr(keyword, vbTab) > 0 Then Exit Function phraseSuggestSearchBackup = txtPhraseSearch.text phraseSuggestListIndexBackup = lstPhrases.ListIndex PopulatePhraseSuggestions keyword If lstPhrases.ListCount = 0 Then txtPhraseSearch.text = phraseSuggestSearchBackup RefreshPhraseList If phraseSuggestListIndexBackup >= 0 And phraseSuggestListIndexBackup < lstPhrases.ListCount Then lstPhrases.ListIndex = phraseSuggestListIndexBackup Exit Function End If phraseSuggestStart = triggerPos - 1 phraseSuggestOriginal = Mid(beforeCursor, triggerPos, cursorPos - phraseSuggestStart) phraseSuggestOriginalLength = Len(phraseSuggestOriginal) phraseSuggestLength = phraseSuggestOriginalLength isPhraseSuggestMode = True ShowPhraseSuggestionList keyword lstPhrases.ListIndex = 0 PreviewPhraseSuggestionSelection lstPhrases.SetFocus TryStartPhraseSuggestionFromBody = True Exit Function SuggestError: EndPhraseSuggestionMode TryStartPhraseSuggestionFromBody = False End Function Private Sub PopulatePhraseSuggestions(ByVal keyword As String) If phraseList = "" Then Exit Sub txtPhraseSearch.text = keyword RefreshPhraseList End Sub Private Sub ShowPhraseSuggestionList(ByVal keyword As String) If Not lblPhrase Is Nothing Then lblPhrase.caption = "추천 구문 목록 - //" & keyword & " (↑↓ 미리보기, Enter 확정, Esc 취소)" If Not lblPhraseDetail Is Nothing Then lblPhraseDetail.caption = "선택된 추천 구문 전체 보기:" End Sub Private Sub HidePhraseSuggestionList() On Error Resume Next If Not txtPhraseDetail Is Nothing Then txtPhraseDetail.Visible = True If Not lblPhrase Is Nothing Then lblPhrase.caption = "자주 쓰는 구문 목록 (더블클릭 삽입)" If Not lblPhraseDetail Is Nothing Then lblPhraseDetail.caption = "선택된 구문 전체 보기 (작성 시 예시로 참고):" On Error GoTo 0 End Sub Private Function GetSuggestionActualIndex() As Long If lstPhrases.ListIndex = -1 Then GetSuggestionActualIndex = -1 Else GetSuggestionActualIndex = val(lstPhrases.List(lstPhrases.ListIndex)) - 1 End If End Function Private Sub PreviewPhraseSuggestionSelection() On Error GoTo PreviewError If Not isPhraseSuggestMode Then Exit Sub If isPhraseSuggestPreviewing Then Exit Sub Dim actualIdx As Long actualIdx = GetSuggestionActualIndex() If actualIdx < 0 Then Exit Sub Dim pArr() As String pArr = Split(phraseList, DELIM) If actualIdx > UBound(pArr) Then Exit Sub isPhraseSuggestPreviewing = True SetBodyLogicalSelection phraseSuggestStart, phraseSuggestLength txtBody.SelText = pArr(actualIdx) phraseSuggestLength = LogicalTextLength(pArr(actualIdx)) SetBodyLogicalSelection phraseSuggestStart + phraseSuggestLength, 0 UpdatePhraseDetail lstPhrases.SetFocus isPhraseSuggestPreviewing = False Exit Sub PreviewError: isPhraseSuggestPreviewing = False End Sub Private Sub RestorePhraseSuggestionTrigger() On Error Resume Next isPhraseSuggestPreviewing = True SetBodyLogicalSelection phraseSuggestStart, phraseSuggestLength txtBody.SelText = phraseSuggestOriginal phraseSuggestLength = phraseSuggestOriginalLength SetBodyLogicalSelection phraseSuggestStart + phraseSuggestOriginalLength, 0 isPhraseSuggestPreviewing = False On Error GoTo 0 End Sub Private Sub ConfirmPhraseSuggestion() If Not isPhraseSuggestMode Then Exit Sub Dim actualIdx As Long actualIdx = GetSuggestionActualIndex() If actualIdx < 0 Then Exit Sub Dim pArr() As String pArr = Split(phraseList, DELIM) If actualIdx > UBound(pArr) Then Exit Sub Dim selectedText As String Dim insertStart As Long Dim replaceLength As Long selectedText = pArr(actualIdx) insertStart = phraseSuggestStart replaceLength = phraseSuggestLength EndPhraseSuggestionMode InsertPhraseIntoBody selectedText, insertStart, replaceLength FocusBodyAtCaret lastBodyCaretLogicalPos End Sub Private Sub CancelPhraseSuggestion() If Not isPhraseSuggestMode Then Exit Sub RestorePhraseSuggestionTrigger EndPhraseSuggestionMode txtBody.SetFocus End Sub Private Sub EndPhraseSuggestionMode() Dim restoreSearch As String Dim restoreIndex As Long restoreSearch = phraseSuggestSearchBackup restoreIndex = phraseSuggestListIndexBackup isPhraseSuggestMode = False isPhraseSuggestPreviewing = False phraseSuggestStart = 0 phraseSuggestLength = 0 phraseSuggestOriginal = "" phraseSuggestOriginalLength = 0 phraseSuggestSearchBackup = "" phraseSuggestListIndexBackup = -1 HidePhraseSuggestionList On Error Resume Next txtPhraseSearch.text = restoreSearch RefreshPhraseList If restoreIndex >= 0 And restoreIndex < lstPhrases.ListCount Then lstPhrases.ListIndex = restoreIndex Else lstPhrases.ListIndex = -1 End If UpdatePhraseDetail On Error GoTo 0 End Sub Private Sub btnPhraseDelete_Click() If isPhraseSuggestMode Then Exit Sub Dim actualIdx As Long actualIdx = GetActualIndex() If actualIdx = -1 Then Exit Sub If MsgBox("선택한 구문을 삭제할까요?", vbYesNo) = vbNo Then Exit Sub Dim pArr() As String pArr = Split(phraseList, DELIM) Dim tArr() As String tArr = Split(tagList, DELIM) If UBound(tArr) < UBound(pArr) Then ReDim Preserve tArr(UBound(pArr)) End If Dim newP() As String Dim newT() As String Dim i As Long Dim count As Long ReDim newP(UBound(pArr)) ReDim newT(UBound(pArr)) For i = LBound(pArr) To UBound(pArr) If i <> actualIdx Then newP(count) = pArr(i) newT(count) = tArr(i) count = count + 1 End If Next i If count = 0 Then phraseList = "" tagList = "" Else ReDim Preserve newP(count - 1) phraseList = Join(newP, DELIM) ReDim Preserve newT(count - 1) tagList = Join(newT, DELIM) End If SaveData RefreshPhraseList End Sub Private Sub btnPhraseTagEdit_Click() If isPhraseSuggestMode Then Exit Sub Dim actualIdx As Long actualIdx = GetActualIndex() If actualIdx = -1 Then Exit Sub If phraseList = "" Then Exit Sub Dim pArr() As String Dim tArr() As String pArr = Split(phraseList, DELIM) tArr = Split(tagList, DELIM) If actualIdx > UBound(pArr) Then Exit Sub If UBound(tArr) < UBound(pArr) Then ReDim Preserve tArr(UBound(pArr)) End If Dim newTag As String newTag = InputBox(TagEditPrompt(), CaptionPhraseTagEdit(), tArr(actualIdx)) If StrPtr(newTag) = 0 Then Exit Sub tArr(actualIdx) = newTag tagList = Join(tArr, DELIM) SaveData RefreshPhraseList End Sub Private Sub btnInsertToken_Click() txtBody.SelText = "{{" & Trim(cboTokenType.text) & "}}" End Sub Private Sub btnClearBody_Click() If Len(txtBody.text) = 0 Then Exit Sub If MsgBox("본문 내용을 모두 지울까요?", vbQuestion + vbYesNo, "본문 지우기") = vbNo Then Exit Sub txtBody.text = "" txtBody.SetFocus End Sub Private Sub btnMemoNow_Click() Dim nowText As String nowText = Format(Now, "hh:mm") If Trim(txtMemoTime1.text) = "" Then txtMemoTime1.text = nowText ElseIf Trim(txtMemoTime2.text) = "" Then txtMemoTime2.text = nowText ElseIf Trim(txtMemoTime3.text) = "" Then txtMemoTime3.text = nowText Else txtMemoTime1.text = nowText End If End Sub Private Sub btnMemoAppend_Click() Dim memoText As String Dim memoSummary As String Dim memoTime As String Dim memoPlace As String Dim memoInmate As String memoTime = FirstMemoTime() memoPlace = FirstMemoPlace() memoInmate = FirstMemoPerson() memoSummary = Trim(txtMemoSummary.text) If memoSummary <> "" Then If memoTime <> "" Then memoText = memoText & memoTime & "경 " If memoPlace <> "" Then memoText = memoText & memoPlace & "에서 " If memoInmate <> "" Then memoText = memoText & memoInmate & " " memoText = memoText & memoSummary Else If memoTime <> "" Then memoText = AppendWithSeparator(memoText, memoTime) If memoPlace <> "" Then memoText = AppendWithSeparator(memoText, memoPlace) If memoInmate <> "" Then memoText = AppendWithSeparator(memoText, memoInmate) End If memoText = Trim(memoText) If memoText = "" Then MsgBox "추가할 메모 내용이 없습니다.", vbInformation, "상황 간단 메모" Exit Sub End If txtBody.SetFocus txtBody.SelText = memoText End Sub Private Sub btnMemoClear_Click() txtMemoTime1.text = "" txtMemoTime2.text = "" txtMemoTime3.text = "" txtMemoInmate1.text = "" txtMemoInmate2.text = "" txtMemoInmate3.text = "" txtMemoInmate4.text = "" txtMemoPlace1.text = "" txtMemoPlace2.text = "" txtMemoPlace3.text = "" txtMemoPlace4.text = "" txtMemoSummary.text = "" txtMemoTime1.SetFocus End Sub Private Function AppendWithSeparator(ByVal currentText As String, ByVal addText As String) As String If Trim(currentText) = "" Then AppendWithSeparator = addText Else AppendWithSeparator = currentText & " / " & addText End If End Function Private Function FirstMemoTime() As String FirstMemoTime = FirstNonBlankText(txtMemoTime1, txtMemoTime2, txtMemoTime3) End Function Private Function FirstMemoPerson() As String FirstMemoPerson = FirstNonBlankText(txtMemoInmate1, txtMemoInmate2, txtMemoInmate3, txtMemoInmate4) End Function Private Function FirstMemoPlace() As String FirstMemoPlace = FirstNonBlankText(txtMemoPlace1, txtMemoPlace2, txtMemoPlace3, txtMemoPlace4) End Function Private Function FirstNonBlankText(ParamArray controls() As Variant) As String Dim i As Long Dim candidate As String For i = LBound(controls) To UBound(controls) On Error Resume Next candidate = Trim(CStr(controls(i).text)) If Err.Number <> 0 Then Err.Clear candidate = "" End If On Error GoTo 0 If candidate <> "" Then FirstNonBlankText = candidate Exit Function End If Next i FirstNonBlankText = "" End Function Private Function MemoAutoReplaceEnabled() As Boolean On Error GoTo UseDefault If chkMemoAutoReplace Is Nothing Then MemoAutoReplaceEnabled = False Else MemoAutoReplaceEnabled = CBool(chkMemoAutoReplace.value) End If Exit Function UseDefault: MemoAutoReplaceEnabled = False End Function Private Function MemoQuickReplaceEnabled() As Boolean On Error GoTo UseDefault If chkMemoQuickReplace Is Nothing Then MemoQuickReplaceEnabled = False Else MemoQuickReplaceEnabled = CBool(chkMemoQuickReplace.value) End If Exit Function UseDefault: MemoQuickReplaceEnabled = False End Function Private Function ReplaceBodyQuickToken() As Boolean On Error GoTo QuickReplaceError Dim cursorPos As Long Dim normalizedText As String Dim beforeCursor As String Dim matchedTrigger As String Dim replacementText As String Dim replacementLogicalLength As Long If Not MemoQuickReplaceEnabled Then Exit Function If txtBody Is Nothing Then Exit Function If txtBody.SelLength <> 0 Then Exit Function cursorPos = TextBoxLogicalPosition(txtBody.text, txtBody.SelStart) If cursorPos <= 0 Then Exit Function normalizedText = TextBoxLogicalText(txtBody.text) If cursorPos > Len(normalizedText) Then cursorPos = Len(normalizedText) beforeCursor = left(normalizedText, cursorPos) replacementText = QuickMemoReplacement(beforeCursor, matchedTrigger) If matchedTrigger = "" Or replacementText = "" Then Exit Function isQuickReplacing = True SetBodyLogicalSelection cursorPos - Len(matchedTrigger), Len(matchedTrigger) txtBody.SelText = replacementText replacementLogicalLength = LogicalTextLength(replacementText) SetBodyLogicalSelection cursorPos - Len(matchedTrigger) + replacementLogicalLength, 0 isQuickReplacing = False ReplaceBodyQuickToken = True Exit Function QuickReplaceError: isQuickReplacing = False ReplaceBodyQuickToken = False End Function Private Function QuickMemoReplacement(ByVal beforeCursor As String, ByRef matchedTrigger As String) As String Dim i As Long Dim triggerText As String Dim result As String For i = 4 To 1 Step -1 triggerText = "/수용자" & CStr(i) If EndsWithText(beforeCursor, triggerText) Then result = MemoPersonText(i, "") If result <> "" Then matchedTrigger = triggerText: QuickMemoReplacement = result: Exit Function End If triggerText = "/당사자" & CStr(i) If EndsWithText(beforeCursor, triggerText) Then result = MemoPersonText(i, "") If result <> "" Then matchedTrigger = triggerText: QuickMemoReplacement = result: Exit Function End If triggerText = "/장소" & CStr(i) If EndsWithText(beforeCursor, triggerText) Then result = MemoPlaceText(i, Trim(txtDefaultLocation.text)) If result <> "" Then matchedTrigger = triggerText: QuickMemoReplacement = result: Exit Function End If Next i For i = 3 To 1 Step -1 triggerText = "/시각" & CStr(i) If EndsWithText(beforeCursor, triggerText) Then result = MemoTimeText(i) If result = "" Then result = Format(Now, "hh:mm") matchedTrigger = triggerText QuickMemoReplacement = result Exit Function End If triggerText = "/시간" & CStr(i) If EndsWithText(beforeCursor, triggerText) Then result = MemoTimeText(i) If result = "" Then result = Format(Now, "hh:mm") matchedTrigger = triggerText QuickMemoReplacement = result Exit Function End If Next i End Function Private Function EndsWithText(ByVal value As String, ByVal suffix As String) As Boolean If Len(value) < Len(suffix) Then Exit Function EndsWithText = (Right(value, Len(suffix)) = suffix) End Function Private Function TokenNumber(ByVal tokenName As String) As Long Dim baseName As String Dim i As Long Dim digits As String Dim ch As String baseName = BaseTokenName(tokenName) For i = Len(baseName) To 1 Step -1 ch = Mid$(baseName, i, 1) If ch >= "0" And ch <= "9" Then digits = ch & digits Else Exit For End If Next i If digits = "" Then TokenNumber = 0 Else TokenNumber = CLng(digits) End If End Function Private Function MemoTimeText(ByVal indexNo As Long) As String If Not MemoAutoReplaceEnabled Then Exit Function Select Case indexNo Case 1 MemoTimeText = Trim(txtMemoTime1.text) Case 2 MemoTimeText = Trim(txtMemoTime2.text) Case 3 MemoTimeText = Trim(txtMemoTime3.text) Case Else MemoTimeText = FirstMemoTime() End Select End Function Private Function MemoPlaceText(ByVal indexNo As Long, ByVal fallback As String) As String Dim result As String If MemoAutoReplaceEnabled Then Select Case indexNo Case 1 result = Trim(txtMemoPlace1.text) Case 2 result = Trim(txtMemoPlace2.text) Case 3 result = Trim(txtMemoPlace3.text) Case 4 result = Trim(txtMemoPlace4.text) Case Else result = FirstMemoPlace() End Select End If If result = "" Then result = fallback MemoPlaceText = result End Function Private Function MemoPersonText(ByVal indexNo As Long, ByVal fallback As String) As String Dim result As String If MemoAutoReplaceEnabled Then Select Case indexNo Case 1 result = Trim(txtMemoInmate1.text) Case 2 result = Trim(txtMemoInmate2.text) Case 3 result = Trim(txtMemoInmate3.text) Case 4 result = Trim(txtMemoInmate4.text) Case Else result = FirstMemoPerson() End Select End If If result = "" Then result = fallback MemoPersonText = result End Function Private Sub ApplyMemoTimeDefaults(ByVal tokenName As String, ByRef defaultDateValue As String, ByRef defHour As String, ByRef defMin As String) Dim memoValue As String memoValue = MemoTimeText(TokenNumber(tokenName)) If memoValue = "" Then Exit Sub ParseMemoTimeText memoValue, defaultDateValue, defHour, defMin End Sub Private Sub ParseMemoTimeText(ByVal memoValue As String, ByRef defaultDateValue As String, ByRef defHour As String, ByRef defMin As String) Dim cleaned As String Dim datePart As String Dim timePart As String Dim parts As Variant Dim spacePos As Long Dim hourPos As Long Dim minuteText As String cleaned = Trim(memoValue) cleaned = Replace(cleaned, " ", " ") spacePos = InStr(cleaned, " ") If spacePos > 0 Then datePart = Trim(left(cleaned, spacePos - 1)) timePart = Trim(Mid(cleaned, spacePos + 1)) If InStr(datePart, ".") > 0 Then defaultDateValue = datePart Else timePart = cleaned End If If InStr(timePart, ":") > 0 Then parts = Split(timePart, ":") If UBound(parts) >= 0 And IsNumeric(parts(0)) Then defHour = Format(CLng(parts(0)), "00") If UBound(parts) >= 1 And IsNumeric(parts(1)) Then defMin = Format(CLng(parts(1)), "00") ElseIf InStr(timePart, "시") > 0 Then hourPos = InStr(timePart, "시") If IsNumeric(Trim(left(timePart, hourPos - 1))) Then defHour = Format(CLng(Trim(left(timePart, hourPos - 1))), "00") minuteText = Trim(Mid(timePart, hourPos + 1)) minuteText = Replace(minuteText, "분", "") If IsNumeric(minuteText) Then defMin = Format(CLng(minuteText), "00") End If End Sub Private Sub btnToggleTransparent_Click() ToggleTransparentMode End Sub Private Sub btnToggleTransparentSettings_Click() ToggleTransparentMode End Sub Private Sub btnPageViewReturn_Click() ToggleTransparentMode End Sub Private Sub ToggleTransparentMode() If isTransparent Then RestoreEditorMode Else EnterPageViewMode End If UpdateTransparentButtonCaptions End Sub Private Sub EnterPageViewMode() UpdateLivePreview ForcePreviewScreenRefresh savedFormLeft = Me.left savedFormTop = Me.top savedFormWidth = Me.Width savedFormHeight = Me.Height savedFormBoundsReady = True isTransparent = True If Not mpMain Is Nothing Then mpMain.Visible = False If Not btnPageViewReturn Is Nothing Then btnPageViewReturn.Visible = True btnPageViewReturn.Move 12, 12, 120, 28 btnPageViewReturn.ZOrder 0 End If Me.Width = 160 Me.Height = 78 MovePageViewBarNearWord On Error Resume Next Application.Activate On Error GoTo 0 End Sub Private Sub RestoreEditorMode() PullSettingsFromPreview False, True, True isTransparent = False If savedFormBoundsReady Then Me.left = savedFormLeft Me.top = savedFormTop Me.Width = savedFormWidth Me.Height = savedFormHeight Else Me.Width = 1000 Me.Height = 790 End If If Not mpMain Is Nothing Then mpMain.Visible = True If Not btnPageViewReturn Is Nothing Then btnPageViewReturn.Visible = False End Sub Private Sub MovePageViewBarNearWord() On Error Resume Next Dim targetLeft As Single Dim targetTop As Single targetLeft = Application.left + Application.Width - Me.Width - 30 targetTop = Application.top + 90 If targetLeft < 20 Then targetLeft = 20 If targetTop < 20 Then targetTop = 20 Me.left = targetLeft Me.top = targetTop On Error GoTo 0 End Sub Private Sub UpdateTransparentButtonCaptions() Dim buttonCaption As String If isTransparent Then buttonCaption = "원래 보기" Else buttonCaption = "페이지 보기" End If On Error Resume Next If Not btnToggleTransparent Is Nothing Then btnToggleTransparent.caption = buttonCaption If Not btnToggleTransparentSettings Is Nothing Then btnToggleTransparentSettings.caption = buttonCaption If Not btnPageViewReturn Is Nothing Then btnPageViewReturn.caption = "작성창 복귀" On Error GoTo 0 End Sub ' ========================================================================= ' 6. 스마트 치환 템플릿 엔진 (토큰 자동완성 및 안전 좌표 입력) ' ========================================================================= Private Sub lstPhrases_Click() If isPhraseSuggestMode Then PreviewPhraseSuggestionSelection Else UpdatePhraseDetail End If End Sub Private Sub lstPhrases_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If isPhraseSuggestMode Then ConfirmPhraseSuggestion Else btnPhraseInsert_Click End If End Sub Private Sub lstPhrases_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If Not isPhraseSuggestMode Then Exit Sub Select Case KeyCode Case vbKeyReturn KeyCode = 0 ConfirmPhraseSuggestion Case vbKeyEscape KeyCode = 0 CancelPhraseSuggestion End Select End Sub Private Sub lstPhrases_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If Not isPhraseSuggestMode Then Exit Sub Select Case KeyCode Case vbKeyUp, vbKeyDown, vbKeyHome, vbKeyEnd, vbKeyPageUp, vbKeyPageDown PreviewPhraseSuggestionSelection End Select End Sub Private Sub btnPhraseInsert_Click() If isPhraseSuggestMode Then ConfirmPhraseSuggestion Exit Sub End If Dim actualIdx As Long actualIdx = GetActualIndex() If actualIdx = -1 Then Exit Sub Dim pArr() As String pArr = Split(phraseList, DELIM) Dim selectedText As String selectedText = pArr(actualIdx) InsertPhraseIntoBody selectedText, TextBoxLogicalPosition(txtBody.text, txtBody.SelStart), LogicalTextLength(txtBody.SelText) End Sub Private Sub InsertPhraseIntoBody(ByVal selectedText As String, ByVal insertStart As Long, ByVal insertLength As Long) Dim insertText As String Dim insertedEnd As Long insertText = selectedText txtBody.SetFocus SetBodyLogicalSelection insertStart, insertLength txtBody.SelText = insertText DoEvents Dim currentText As String Dim searchString As String Dim tagStart As Long Dim tagEnd As Long Dim tokenName As String Dim userInput As String Dim defaultInput As String Dim searchStart As Long Dim inputDate As String Dim inputHour As String Dim inputMin As String Dim defaultDateValue As String Dim defHour As String Dim defMin As String ' 자주 쓰는 구문 목록 쪽에 InputBox가 뜨도록 UserForm 좌측 목록 영역 기준으로 좌표를 잡고, ' VBA InputBox 좌표 한계(-32768~32767)를 넘지 않게 막습니다. Dim posX As Long Dim posY As Long Dim rawPosX As Double Dim rawPosY As Double posX = 12000 posY = 8000 On Error Resume Next rawPosX = (Me.left + lstPhrases.left + 25) * 20 rawPosY = (Me.top + lstPhrases.top + 35) * 20 If Err.Number = 0 Then posX = CLng(rawPosX) posY = CLng(rawPosY) End If Err.Clear On Error GoTo 0 If posX > 32767 Then posX = 32767 If posX < -32768 Then posX = -32768 If posY > 32767 Then posY = 32767 If posY < -32768 Then posY = -32768 searchStart = insertStart + 1 insertedEnd = insertStart + LogicalTextLength(selectedText) Do currentText = txtBody.text searchString = Replace(Replace(currentText, vbCrLf, vbCr), vbLf, vbCr) tagStart = InStr(searchStart, searchString, "{{") If tagStart = 0 Then Exit Do If tagStart > insertedEnd Then Exit Do tagEnd = InStr(tagStart + 2, searchString, "}}") If tagEnd = 0 Then Exit Do If tagEnd + 1 > insertedEnd Then Exit Do tokenName = Mid(searchString, tagStart + 2, tagEnd - tagStart - 2) SetBodyLogicalSelection tagStart - 1, (tagEnd - tagStart) + 2 DoEvents If InStr(tokenName, "시각") > 0 Then If chkAutoDateTime.value = True Then defaultDateValue = Format(Now, "yyyy.mm.dd") defHour = Format(Now, "hh") defMin = Format(Now, "mm") ApplyMemoTimeDefaults tokenName, defaultDateValue, defHour, defMin inputDate = InputBox("[" & tokenName & "] - [년.월.일]을 확인/수정하세요.", "시각 설정 - [날짜] 입력", defaultDateValue, posX, posY) If StrPtr(inputDate) = 0 Then Exit Do If Trim(inputDate) = "" Then inputDate = defaultDateValue inputHour = InputBox("[" & tokenName & "] - 시간[시]를 확인/수정하세요.", "시각 설정 - [시] 입력", defHour, posX, posY) If StrPtr(inputHour) = 0 Then Exit Do If Trim(inputHour) = "" Then inputHour = defHour inputMin = InputBox("[" & tokenName & "] - 시간[분]을 확인/수정하세요.", "시각 설정 - [분] 입력", defMin, posX, posY) If StrPtr(inputMin) = 0 Then Exit Do If Trim(inputMin) = "" Then inputMin = defMin userInput = Trim(inputDate) & " " & Trim(inputHour) & "시 " & Trim(inputMin) & "분" Else defaultInput = MemoTimeText(TokenNumber(tokenName)) userInput = InputBox(TokenInputPrompt(tokenName), TokenInputTitle(), defaultInput, posX, posY) If StrPtr(userInput) = 0 Then Exit Do End If ElseIf InStr(tokenName, "장소") > 0 Then defaultInput = MemoPlaceText(TokenNumber(tokenName), Trim(txtDefaultLocation.text)) userInput = InputBox(TokenInputPrompt(tokenName), TokenInputTitle(), defaultInput, posX, posY) If StrPtr(userInput) = 0 Then Exit Do ElseIf InStr(tokenName, "수용자") > 0 Or InStr(tokenName, "당사자") > 0 Then defaultInput = MemoPersonText(TokenNumber(tokenName), "") userInput = InputBox(TokenInputPrompt(BaseTokenName(tokenName)), TokenInputTitle(), defaultInput, posX, posY) If StrPtr(userInput) = 0 Then Exit Do If Trim(userInput) <> "" Then userInput = ApplyKoreanParticle(Trim(userInput), tokenName) Else userInput = InputBox(TokenInputPrompt(tokenName), TokenInputTitle(), "", posX, posY) If StrPtr(userInput) = 0 Then Exit Do End If If Trim(userInput) = "" Then searchStart = tagEnd + 2 Else txtBody.SelText = userInput insertedEnd = insertedEnd - ((tagEnd - tagStart) + 2) + LogicalTextLength(userInput) searchStart = tagStart + LogicalTextLength(userInput) End If DoEvents Loop lastBodyCaretLogicalPos = insertedEnd FocusBodyAtCaret insertedEnd End Sub Private Sub FocusBodyAtCaret(ByVal logicalPos As Long) On Error Resume Next If Not mpMain Is Nothing Then mpMain.value = 0 If txtBody Is Nothing Then Exit Sub Dim maxPos As Long maxPos = LogicalTextLength(txtBody.text) If logicalPos < 0 Then logicalPos = 0 If logicalPos > maxPos Then logicalPos = maxPos Dim actualPos As Long actualPos = TextBoxActualPosition(txtBody.text, logicalPos) txtBody.SetFocus txtBody.SelStart = actualPos txtBody.SelLength = 0 Me.Repaint DoEvents txtBody.SetFocus txtBody.SelStart = actualPos txtBody.SelLength = 0 On Error GoTo 0 End Sub ' ========================================================================= ' 7. 문서 페이지 보기 및 서식 핸들링 ' ========================================================================= Private Sub btnPullPreviewSettings_Click() PullSettingsFromPreview True End Sub Private Sub PullSettingsFromPreview(Optional ByVal refreshPreview As Boolean = True, Optional ByVal pullBodyText As Boolean = False, Optional ByVal pullSpacing As Boolean = True) On Error GoTo PullError Dim doc As Document Set doc = ThisDocument Dim previewRange As Range If doc.Bookmarks.Exists(PREVIEW_BOOKMARK) Then Set previewRange = doc.Bookmarks(PREVIEW_BOOKMARK).Range Else If refreshPreview And Not pullBodyText Then UpdateLivePreview If doc.Bookmarks.Exists(PREVIEW_BOOKMARK) Then Set previewRange = doc.Bookmarks(PREVIEW_BOOKMARK).Range ElseIf pullBodyText Then Set previewRange = doc.Range(0, doc.Content.End - 1) Else Exit Sub End If End If If previewRange.Paragraphs.count = 0 Then Exit Sub Dim nonEmpty() As Long Dim nonEmptyCount As Long Dim i As Long ReDim nonEmpty(1 To previewRange.Paragraphs.count) For i = 1 To previewRange.Paragraphs.count If Not IsBlankPreviewParagraph(previewRange.Paragraphs(i).Range) Then nonEmptyCount = nonEmptyCount + 1 nonEmpty(nonEmptyCount) = i End If Next i If nonEmptyCount = 0 Then Exit Sub ReDim Preserve nonEmpty(1 To nonEmptyCount) Dim oldUpdating As Boolean oldUpdating = isPreviewUpdating isPreviewUpdating = True Dim titleIdx As Long Dim dateIdx As Long Dim signIdx As Long Dim orgIdx As Long Dim bodyFirstIdx As Long Dim bodyLastIdx As Long titleIdx = nonEmpty(1) txtTitleSize.text = CStr(PreviewParagraphFontSize(previewRange.Paragraphs(titleIdx).Range, PreviewNumber(txtTitleSize, 34, 8, 80))) txtTitleFontName.text = PreviewParagraphFontName(previewRange.Paragraphs(titleIdx).Range, TitleFontName()) chkTitleBold.value = PreviewParagraphBold(previewRange.Paragraphs(titleIdx).Range, TitleBoldEnabled()) StoreParagraphFormatFromPreview "Title", previewRange.Paragraphs(titleIdx).Range On Error Resume Next txtTitleSpacing.text = CStr(CLng(previewRange.Paragraphs(titleIdx).Range.Font.spacing)) On Error GoTo 0 If nonEmptyCount >= 4 Then dateIdx = nonEmpty(nonEmptyCount - 2) signIdx = nonEmpty(nonEmptyCount - 1) orgIdx = nonEmpty(nonEmptyCount) txtDateSize.text = CStr(PreviewParagraphFontSize(previewRange.Paragraphs(dateIdx).Range, PreviewParagraphFontSize(previewRange.Paragraphs(signIdx).Range, PreviewNumber(txtDateSize, 16, 8, 40)))) txtDateFontName.text = PreviewParagraphFontName(previewRange.Paragraphs(dateIdx).Range, DateFontName()) chkDateBold.value = PreviewParagraphBold(previewRange.Paragraphs(dateIdx).Range, DateBoldEnabled()) StoreParagraphFormatFromPreview "Date", previewRange.Paragraphs(dateIdx).Range StoreParagraphFormatFromPreview "Sign", previewRange.Paragraphs(signIdx).Range txtOrgSize.text = CStr(PreviewParagraphFontSize(previewRange.Paragraphs(orgIdx).Range, PreviewNumber(txtOrgSize, 42, 8, 90))) txtOrgFontName.text = PreviewParagraphFontName(previewRange.Paragraphs(orgIdx).Range, OrgFontName()) chkOrgBold.value = PreviewParagraphBold(previewRange.Paragraphs(orgIdx).Range, OrgBoldEnabled()) StoreParagraphFormatFromPreview "Org", previewRange.Paragraphs(orgIdx).Range On Error Resume Next txtOrgSpacing.text = CStr(CLng(previewRange.Paragraphs(orgIdx).Range.Font.spacing)) On Error GoTo 0 For i = 2 To nonEmptyCount - 3 If nonEmpty(i) > titleIdx And nonEmpty(i) < dateIdx Then If bodyFirstIdx = 0 Then bodyFirstIdx = nonEmpty(i) bodyLastIdx = nonEmpty(i) End If Next i If bodyFirstIdx > 0 Then txtBodySize.text = CStr(PreviewParagraphFontSize(previewRange.Paragraphs(bodyFirstIdx).Range, PreviewNumber(txtBodySize, 14, 8, 40))) txtBodyFontName.text = PreviewParagraphFontName(previewRange.Paragraphs(bodyFirstIdx).Range, BodyFontName()) chkBodyBold.value = PreviewParagraphBold(previewRange.Paragraphs(bodyFirstIdx).Range, BodyBoldEnabled()) StoreParagraphFormatFromPreview "Body", previewRange.Paragraphs(bodyFirstIdx).Range StoreGapParagraphFormat previewRange.Paragraphs, titleIdx, bodyFirstIdx, "GapTB" StoreGapParagraphFormat previewRange.Paragraphs, bodyLastIdx, dateIdx, "GapBD" If pullSpacing Then txtSpaceTB.text = CStr(CountBlankParagraphsBetween(previewRange.Paragraphs, titleIdx, bodyFirstIdx)) txtSpaceBD.text = CStr(CountBlankParagraphsBetween(previewRange.Paragraphs, bodyLastIdx, dateIdx)) End If If pullBodyText Then txtBody.text = PreviewBodyText(previewRange.Paragraphs, bodyFirstIdx, bodyLastIdx) Else StoreGapParagraphFormat previewRange.Paragraphs, titleIdx, dateIdx, "GapTB" If pullSpacing Then txtSpaceTB.text = CStr(CountBlankParagraphsBetween(previewRange.Paragraphs, titleIdx, dateIdx)) If pullBodyText Then txtBody.text = "" End If StoreGapParagraphFormat previewRange.Paragraphs, dateIdx, signIdx, "GapDS" StoreGapParagraphFormat previewRange.Paragraphs, signIdx, orgIdx, "GapSO" If pullSpacing Then txtSpaceDS.text = CStr(CountBlankParagraphsBetween(previewRange.Paragraphs, dateIdx, signIdx)) txtSpaceSO.text = CStr(CountBlankParagraphsBetween(previewRange.Paragraphs, signIdx, orgIdx)) End If ElseIf nonEmptyCount >= 2 Then orgIdx = nonEmpty(nonEmptyCount) txtOrgSize.text = CStr(PreviewParagraphFontSize(previewRange.Paragraphs(orgIdx).Range, PreviewNumber(txtOrgSize, 42, 8, 90))) txtOrgFontName.text = PreviewParagraphFontName(previewRange.Paragraphs(orgIdx).Range, OrgFontName()) chkOrgBold.value = PreviewParagraphBold(previewRange.Paragraphs(orgIdx).Range, OrgBoldEnabled()) StoreParagraphFormatFromPreview "Org", previewRange.Paragraphs(orgIdx).Range On Error Resume Next txtOrgSpacing.text = CStr(CLng(previewRange.Paragraphs(orgIdx).Range.Font.spacing)) On Error GoTo 0 End If isPreviewUpdating = oldUpdating SaveData If refreshPreview And Not oldUpdating Then UpdateLivePreview Exit Sub PullError: isPreviewUpdating = False End Sub Private Function IsBlankPreviewParagraph(ByVal target As Range) As Boolean Dim value As String value = target.text value = Replace(value, vbCr, "") value = Replace(value, vbLf, "") value = Replace(value, Chr$(7), "") IsBlankPreviewParagraph = (Trim(value) = "") End Function Private Function PreviewParagraphFontSize(ByVal target As Range, ByVal fallback As Long) As Long On Error GoTo UseFallback Dim s As Single s = CSng(target.Font.Size) If s <= 0 Or s > 200 Then GoTo UseFallback Else PreviewParagraphFontSize = CLng(s + 0.5) Exit Function End If UseFallback: PreviewParagraphFontSize = fallback End Function Private Function PreviewParagraphFontName(ByVal target As Range, ByVal fallback As String) As String On Error GoTo UseFallback Dim value As String Dim i As Long Dim charText As String value = CleanFontName(target.Font.NameFarEast) If value = "" Then value = CleanFontName(target.Font.name) If value <> "" Then PreviewParagraphFontName = value Exit Function End If For i = 1 To target.Characters.count charText = target.Characters(i).text If charText <> vbCr And charText <> vbLf And charText <> Chr$(7) And Trim(charText) <> "" Then value = CleanFontName(target.Characters(i).Font.NameFarEast) If value = "" Then value = CleanFontName(target.Characters(i).Font.name) If value <> "" Then PreviewParagraphFontName = value Exit Function End If End If Next i UseFallback: PreviewParagraphFontName = fallback End Function Private Function CleanFontName(ByVal value As String) As String value = Trim(value) If value = "" Then Exit Function If left(value, 1) = "+" Then Exit Function If InStr(value, ",") > 0 Then value = Trim(left(value, InStr(value, ",") - 1)) CleanFontName = value End Function Private Function PreviewParagraphBold(ByVal target As Range, ByVal fallback As Boolean) As Boolean On Error GoTo UseFallback Dim boldValue As Long boldValue = CLng(target.Font.Bold) If boldValue = 0 Then PreviewParagraphBold = False ElseIf boldValue = -1 Then PreviewParagraphBold = True Else PreviewParagraphBold = fallback End If Exit Function UseFallback: PreviewParagraphBold = fallback End Function Private Function PreviewBodyText(ByVal paras As Paragraphs, ByVal firstIdx As Long, ByVal lastIdx As Long) As String Dim i As Long Dim result As String Dim lineText As String If firstIdx <= 0 Or lastIdx < firstIdx Then Exit Function For i = firstIdx To lastIdx lineText = CleanPreviewParagraphText(paras(i).Range) If result <> "" Then result = result & vbCrLf result = result & lineText Next i PreviewBodyText = result End Function Private Function CleanPreviewParagraphText(ByVal target As Range) As String Dim value As String Dim lastChar As String value = Replace(target.text, Chr$(7), "") Do While Len(value) > 0 lastChar = Right$(value, 1) If lastChar = vbCr Or lastChar = vbLf Then value = left(value, Len(value) - 1) Else Exit Do End If Loop CleanPreviewParagraphText = value End Function Private Function CountBlankParagraphsBetween(ByVal paras As Paragraphs, ByVal LIdx As Long, ByVal RIdx As Long) As Long Dim i As Long If RIdx <= LIdx + 1 Then Exit Function For i = LIdx + 1 To RIdx - 1 If IsBlankPreviewParagraph(paras(i).Range) Then CountBlankParagraphsBetween = CountBlankParagraphsBetween + 1 End If Next i End Function Private Sub StoreParagraphFormatFromPreview(ByVal paraKey As String, ByVal target As Range) On Error Resume Next If paraKey = "" Then Exit Sub SetVar ParagraphFormatVarName(paraKey, "Rule"), CStr(CLng(target.ParagraphFormat.LineSpacingRule)) SetVar ParagraphFormatVarName(paraKey, "Line"), CStr(CSng(target.ParagraphFormat.LineSpacing)) SetVar ParagraphFormatVarName(paraKey, "Before"), CStr(CSng(target.ParagraphFormat.SpaceBefore)) SetVar ParagraphFormatVarName(paraKey, "After"), CStr(CSng(target.ParagraphFormat.SpaceAfter)) If IsBlankPreviewParagraph(target) Then SetVar ParagraphFormatVarName(paraKey, "FontSize"), CStr(PreviewParagraphFontSize(target, 12)) End If On Error GoTo 0 End Sub Private Sub StoreGapParagraphFormat(ByVal paras As Paragraphs, ByVal LIdx As Long, ByVal RIdx As Long, ByVal paraKey As String) On Error Resume Next Dim i As Long If RIdx <= LIdx + 1 Then Exit Sub For i = LIdx + 1 To RIdx - 1 If IsBlankPreviewParagraph(paras(i).Range) Then StoreParagraphFormatFromPreview paraKey, paras(i).Range Exit Sub End If Next i On Error GoTo 0 End Sub Private Sub ApplyStoredParagraphFormat(ByVal target As Range, ByVal paraKey As String) On Error Resume Next If paraKey = "" Then Exit Sub Dim sourceKey As String sourceKey = paraKey If paraKey = "Sign" And GetVar(ParagraphFormatVarName(sourceKey, "Rule"), "") = "" Then sourceKey = "Date" Dim defaultRule As Long Dim defaultLine As Single If left(sourceKey, 3) = "Gap" Then defaultRule = wdLineSpaceExactly defaultLine = 12 Else defaultRule = wdLineSpaceMultiple defaultLine = 12 * 1.6 End If With target.ParagraphFormat .LineSpacingRule = ParagraphLongSetting(sourceKey, "Rule", defaultRule) .LineSpacing = ParagraphSingleSetting(sourceKey, "Line", defaultLine) If ParagraphSettingExists(sourceKey, "Before") Then .SpaceBefore = ParagraphSingleSetting(sourceKey, "Before", .SpaceBefore) If ParagraphSettingExists(sourceKey, "After") Then .SpaceAfter = ParagraphSingleSetting(sourceKey, "After", .SpaceAfter) End With On Error GoTo 0 End Sub Private Function ParagraphFontSizeForKey(ByVal paraKey As String, ByVal fallback As Long) As Long ParagraphFontSizeForKey = ParagraphLongSetting(paraKey, "FontSize", fallback) If ParagraphFontSizeForKey < 1 Or ParagraphFontSizeForKey > 200 Then ParagraphFontSizeForKey = fallback End Function Private Function ParagraphLongSetting(ByVal paraKey As String, ByVal settingName As String, ByVal fallback As Long) As Long On Error GoTo UseFallback Dim value As String value = Trim(GetVar(ParagraphFormatVarName(paraKey, settingName), "")) If value = "" Or Not IsNumeric(value) Then GoTo UseFallback ParagraphLongSetting = CLng(value) Exit Function UseFallback: ParagraphLongSetting = fallback End Function Private Function ParagraphSingleSetting(ByVal paraKey As String, ByVal settingName As String, ByVal fallback As Single) As Single On Error GoTo UseFallback Dim value As String value = Trim(GetVar(ParagraphFormatVarName(paraKey, settingName), "")) If value = "" Or Not IsNumeric(value) Then GoTo UseFallback ParagraphSingleSetting = CSng(value) Exit Function UseFallback: ParagraphSingleSetting = fallback End Function Private Function ParagraphFormatVarName(ByVal paraKey As String, ByVal settingName As String) As String ParagraphFormatVarName = "Cfg_Para_" & paraKey & "_" & settingName End Function Private Function ParagraphSettingExists(ByVal paraKey As String, ByVal settingName As String) As Boolean ParagraphSettingExists = (GetVar(ParagraphFormatVarName(paraKey, settingName), "") <> "") End Function Private Sub UserForm_Terminate() SaveData End Sub Private Sub txtRank_AfterUpdate() SetVar "Cfg_Rank", txtRank.text SaveHostDocument End Sub Private Sub txtEmpName_AfterUpdate() SetVar "Cfg_Name", txtEmpName.text SaveHostDocument End Sub Private Sub txtBody_Change() If isQuickReplacing Then Exit Sub If isPreviewUpdating Then Exit Sub If isPhraseSuggestPreviewing Then Exit Sub ReplaceBodyQuickToken End Sub Private Sub txtBody_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyReturn Then If TryStartPhraseSuggestionFromBody() Then KeyCode = 0 End If ElseIf KeyCode = vbKeyEscape Then If isPhraseSuggestMode Then KeyCode = 0 CancelPhraseSuggestion End If End If End Sub Private Sub txtReportDate_Change() End Sub Private Sub txtRank_Change() End Sub Private Sub txtEmpName_Change() End Sub Private Sub txtDocTitle_Change() End Sub Private Sub txtOrgName_Change() End Sub Private Sub txtTitleSize_Change() End Sub Private Sub txtBodySize_Change() End Sub Private Sub txtDateSize_Change() End Sub Private Sub txtOrgSize_Change() End Sub Private Sub txtSpaceTB_Change() End Sub Private Sub txtSpaceBD_Change() End Sub Private Sub txtSpaceDS_Change() End Sub Private Sub txtSpaceSO_Change() End Sub Private Sub txtTitleSpacing_Change() End Sub Private Sub txtOrgSpacing_Change() End Sub Private Sub UpdateLivePreview() If isPreviewUpdating Then Exit Sub If txtBody Is Nothing Then Exit Sub On Error GoTo CleanUp isPreviewUpdating = True Application.ScreenUpdating = False Dim doc As Document Set doc = ThisDocument With doc.PageSetup .PaperSize = wdPaperA4 .TopMargin = MillimetersToPoints(25) .BottomMargin = MillimetersToPoints(25) .LeftMargin = MillimetersToPoints(25) .RightMargin = MillimetersToPoints(25) End With Dim previewLines As Collection Dim previewAligns As Collection Dim previewSizes As Collection Dim previewFonts As Collection Dim previewBolds As Collection Dim previewSpacings As Collection Dim previewParaKeys As Collection Set previewLines = New Collection Set previewAligns = New Collection Set previewSizes = New Collection Set previewFonts = New Collection Set previewBolds = New Collection Set previewSpacings = New Collection Set previewParaKeys = New Collection Dim titleSize As Long, bodySize As Long, dateSize As Long, orgSize As Long titleSize = PreviewNumber(txtTitleSize, 34, 8, 80) bodySize = PreviewNumber(txtBodySize, 14, 8, 40) dateSize = PreviewNumber(txtDateSize, 16, 8, 40) orgSize = PreviewNumber(txtOrgSize, 42, 8, 90) Dim titleSpc As Long Dim orgSpc As Long Dim titleFont As String Dim bodyFont As String Dim dateFont As String Dim orgFont As String Dim titleBold As Boolean Dim bodyBold As Boolean Dim dateBold As Boolean Dim orgBold As Boolean titleSpc = PreviewNumber(txtTitleSpacing, 7, -20, 100) orgSpc = PreviewNumber(txtOrgSpacing, 7, -20, 100) titleFont = TitleFontName() bodyFont = BodyFontName() dateFont = DateFontName() orgFont = OrgFontName() titleBold = TitleBoldEnabled() bodyBold = BodyBoldEnabled() dateBold = DateBoldEnabled() orgBold = OrgBoldEnabled() AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewText(txtDocTitle, DefaultDocTitle()), wdAlignParagraphCenter, titleSize, titleFont, titleBold, titleSpc, "Title" AddPreviewBlankLines previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewNumber(txtSpaceTB, 1, 0, 20), bodyFont, "GapTB" Dim finalBody As String finalBody = Replace(Replace(PreviewText(txtBody, ""), vbCrLf, vbLf), vbCr, vbLf) Dim bodyLines As Variant Dim i As Long If Len(finalBody) = 0 Then AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, "", wdAlignParagraphLeft, bodySize, bodyFont, bodyBold, 0, "Body" Else bodyLines = Split(finalBody, vbLf) For i = LBound(bodyLines) To UBound(bodyLines) AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, CStr(bodyLines(i)), wdAlignParagraphLeft, bodySize, bodyFont, bodyBold, 0, "Body" Next i End If AddPreviewBlankLines previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewNumber(txtSpaceBD, 3, 0, 20), bodyFont, "GapBD" AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewText(txtReportDate, ""), wdAlignParagraphRight, dateSize, dateFont, dateBold, 0, "Date" AddPreviewBlankLines previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewNumber(txtSpaceDS, 0, 0, 20), dateFont, "GapDS" AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, Trim(PreviewText(txtRank, "") & " " & PreviewText(txtEmpName, "") & " " & SignatureLabel()), wdAlignParagraphRight, dateSize, dateFont, dateBold, 0, "Sign" AddPreviewBlankLines previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewNumber(txtSpaceSO, 2, 0, 20), orgFont, "GapSO" AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, PreviewText(txtOrgName, DefaultOrgName()), wdAlignParagraphCenter, orgSize, orgFont, orgBold, orgSpc, "Org" Dim previewTextValue As String For i = 1 To previewLines.count previewTextValue = previewTextValue & CStr(previewLines(i)) If i < previewLines.count Then previewTextValue = previewTextValue & vbCr End If Next i Dim startPos As Long Dim endPos As Long If doc.Bookmarks.Exists(PREVIEW_BOOKMARK) Then startPos = doc.Bookmarks(PREVIEW_BOOKMARK).Range.Start endPos = doc.Bookmarks(PREVIEW_BOOKMARK).Range.End Else startPos = 0 endPos = doc.Content.End - 1 End If If endPos < startPos Then endPos = startPos Dim target As Range Set target = doc.Range(startPos, endPos) target.text = previewTextValue Set target = doc.Range(startPos, startPos + Len(previewTextValue)) For i = 1 To previewLines.count If i <= target.Paragraphs.count Then ApplyPreviewParagraphStyle target.Paragraphs(i).Range, CLng(previewAligns(i)), CLng(previewSizes(i)), CStr(previewFonts(i)), CBool(previewBolds(i)), CSng(previewSpacings(i)), CStr(previewParaKeys(i)) End If Next i If doc.Bookmarks.Exists(PREVIEW_BOOKMARK) Then doc.Bookmarks(PREVIEW_BOOKMARK).Delete doc.Bookmarks.Add PREVIEW_BOOKMARK, target CleanUp: Application.ScreenUpdating = True isPreviewUpdating = False End Sub Private Sub AddPreviewLine(ByVal previewLines As Collection, ByVal previewAligns As Collection, ByVal previewSizes As Collection, ByVal previewFonts As Collection, ByVal previewBolds As Collection, ByVal previewSpacings As Collection, ByVal previewParaKeys As Collection, ByVal lineText As String, ByVal align As Long, ByVal fontSize As Long, ByVal fontName As String, ByVal isBold As Boolean, ByVal spacing As Single, ByVal paraKey As String) previewLines.Add lineText previewAligns.Add align previewSizes.Add fontSize previewFonts.Add fontName previewBolds.Add isBold previewSpacings.Add spacing previewParaKeys.Add paraKey End Sub Private Sub AddPreviewBlankLines(ByVal previewLines As Collection, ByVal previewAligns As Collection, ByVal previewSizes As Collection, ByVal previewFonts As Collection, ByVal previewBolds As Collection, ByVal previewSpacings As Collection, ByVal previewParaKeys As Collection, ByVal blankCount As Long, ByVal fontName As String, ByVal paraKey As String) Dim j As Long Dim blankSize As Long blankSize = ParagraphFontSizeForKey(paraKey, 12) For j = 1 To blankCount AddPreviewLine previewLines, previewAligns, previewSizes, previewFonts, previewBolds, previewSpacings, previewParaKeys, "", wdAlignParagraphLeft, blankSize, fontName, False, 0, paraKey Next j End Sub Private Sub ApplyPreviewParagraphStyle(ByVal target As Range, ByVal align As Long, ByVal fontSize As Long, ByVal fontName As String, ByVal isBold As Boolean, ByVal charSpacing As Single, ByVal paraKey As String) With target .Font.name = fontName .Font.NameFarEast = fontName .Font.Size = fontSize .Font.Bold = isBold .Font.spacing = charSpacing .ParagraphFormat.Alignment = align End With ApplyStoredParagraphFormat target, paraKey End Sub Private Function DefaultDocTitle() As String DefaultDocTitle = "근무보고서" End Function Private Function SignatureLabel() As String SignatureLabel = "(" & ChrW$(&HC11C) & ChrW$(&HBA85) & ")" End Function Private Function DefaultOrgName() As String DefaultOrgName = ChrW$(&HC548) & ChrW$(&HC591) & ChrW$(&HAD50) & ChrW$(&HB3C4) & ChrW$(&HC18C) & ChrW$(&HC7A5) & ChrW$(&HADC0) & ChrW$(&HD558) End Function Private Sub ForcePreviewScreenRefresh() On Error Resume Next Application.ScreenUpdating = True Application.ScreenRefresh Me.Repaint DoEvents End Sub Private Function CaptionPhraseInsert() As String CaptionPhraseInsert = ChrW$(&HAD6C) & ChrW$(&HBB38) & " " & ChrW$(&HC0BD) & ChrW$(&HC785) End Function Private Function CaptionPhraseTagEdit() As String CaptionPhraseTagEdit = ChrW$(&HD0DC) & ChrW$(&HADF8) & " " & ChrW$(&HC218) & ChrW$(&HC815) End Function Private Function CaptionPhraseDelete() As String CaptionPhraseDelete = ChrW$(&HAD6C) & ChrW$(&HBB38) & " " & ChrW$(&HC0AD) & ChrW$(&HC81C) End Function Private Function CaptionSaveSettings() As String CaptionSaveSettings = ChrW$(&HC124) & ChrW$(&HC815) & " " & ChrW$(&HB0B4) & ChrW$(&HC6A9) & " " & ChrW$(&HC800) & ChrW$(&HC7A5) End Function Private Function CaptionPullPreviewSettings() As String CaptionPullPreviewSettings = ChrW$(&HBBF8) & ChrW$(&HB9AC) & ChrW$(&HBCF4) & ChrW$(&HAE30) & " " & ChrW$(&HC11C) & ChrW$(&HC2DD) & " " & ChrW$(&HAC00) & ChrW$(&HC838) & ChrW$(&HC624) & ChrW$(&HAE30) End Function Private Function TagEditPrompt() As String TagEditPrompt = ChrW$(&HC0C8) & " " & ChrW$(&HD0DC) & ChrW$(&HADF8) & ChrW$(&HB97C) & " " & ChrW$(&HC785) & ChrW$(&HB825) & ChrW$(&HD558) & ChrW$(&HC138) & ChrW$(&HC694) & "." End Function Private Function TokenInputTitle() As String TokenInputTitle = ChrW$(&HD1A0) & ChrW$(&HD070) & " " & ChrW$(&HC785) & ChrW$(&HB825) End Function Private Function TokenInputPrompt(ByVal tokenName As String) As String TokenInputPrompt = "[" & tokenName & "] " & ChrW$(&HB0B4) & ChrW$(&HC6A9) & ChrW$(&HC744) & " " & ChrW$(&HC785) & ChrW$(&HB825) & ChrW$(&HD558) & ChrW$(&HC138) & ChrW$(&HC694) & "." & vbCrLf & vbCrLf & _ "- " & ChrW$(&HBE48) & ChrW$(&HCE78) & " " & ChrW$(&HD655) & ChrW$(&HC778) & ": " & ChrW$(&HD0DC) & ChrW$(&HADF8) & " " & ChrW$(&HC720) & ChrW$(&HC9C0) & vbCrLf & _ "- " & ChrW$(&HCDE8) & ChrW$(&HC18C) & ": " & ChrW$(&HB0A8) & ChrW$(&HC740) & " " & ChrW$(&HD0DC) & ChrW$(&HADF8) & " " & ChrW$(&HBCC0) & ChrW$(&HACBD) & " " & ChrW$(&HC885) & ChrW$(&HB8CC) End Function Private Function BaseTokenName(ByVal tokenName As String) As String Dim sepPos As Long sepPos = InStr(tokenName, ":") If sepPos > 0 Then BaseTokenName = Trim(left(tokenName, sepPos - 1)) Else BaseTokenName = Trim(tokenName) End If End Function Private Function TokenParticleSpec(ByVal tokenName As String) As String Dim sepPos As Long sepPos = InStr(tokenName, ":") If sepPos > 0 Then TokenParticleSpec = Replace(Trim(Mid(tokenName, sepPos + 1)), " ", "") Else TokenParticleSpec = "" End If End Function Private Function ApplyKoreanParticle(ByVal baseText As String, ByVal tokenName As String) As String Dim particleSpec As String Dim selectedParticle As String particleSpec = TokenParticleSpec(tokenName) selectedParticle = KoreanParticle(baseText, particleSpec) If selectedParticle = "" Then ApplyKoreanParticle = baseText Else ApplyKoreanParticle = baseText & selectedParticle End If End Function Private Function KoreanParticle(ByVal baseText As String, ByVal particleSpec As String) As String Dim finalIndex As Long finalIndex = HangulFinalIndex(baseText) Select Case particleSpec Case "이/가", "가/이" If finalIndex > 0 Then KoreanParticle = "이" Else KoreanParticle = "가" Case "은/는", "는/은" If finalIndex > 0 Then KoreanParticle = "은" Else KoreanParticle = "는" Case "을/를", "를/을" If finalIndex > 0 Then KoreanParticle = "을" Else KoreanParticle = "를" Case "과/와", "와/과" If finalIndex > 0 Then KoreanParticle = "과" Else KoreanParticle = "와" Case "으로/로", "로/으로" If finalIndex > 0 And finalIndex <> 8 Then KoreanParticle = "으로" Else KoreanParticle = "로" Case "아/야", "야/아" If finalIndex > 0 Then KoreanParticle = "아" Else KoreanParticle = "야" Case Else KoreanParticle = "" End Select End Function Private Function HangulFinalIndex(ByVal value As String) As Long Dim i As Long Dim codePoint As Long Dim ch As String For i = Len(value) To 1 Step -1 ch = Mid$(value, i, 1) If Trim(ch) <> "" Then codePoint = AscW(ch) If codePoint < 0 Then codePoint = codePoint + 65536 If codePoint >= 44032 And codePoint <= 55203 Then HangulFinalIndex = (codePoint - 44032) Mod 28 Exit Function End If End If Next i HangulFinalIndex = 0 End Function Private Function PreviewText(ByVal ctl As MSForms.TextBox, ByVal fallback As String) As String On Error GoTo UseFallback If ctl Is Nothing Then GoTo UseFallback End If PreviewText = ctl.text Exit Function UseFallback: PreviewText = fallback End Function Private Function PreviewNumber(ByVal ctl As MSForms.TextBox, ByVal fallback As Long, ByVal minVal As Long, ByVal maxVal As Long) As Long On Error GoTo UseFallback If ctl Is Nothing Then GoTo UseFallback End If If IsNumeric(Trim(ctl.text)) Then PreviewNumber = CLng(Trim(ctl.text)) Else PreviewNumber = fallback End If If PreviewNumber < minVal Then PreviewNumber = minVal If PreviewNumber > maxVal Then PreviewNumber = maxVal Exit Function UseFallback: PreviewNumber = fallback End Function Private Function TitleFontName() As String On Error GoTo UseDefault Dim value As String value = Trim(txtTitleFontName.text) If value = "" Then value = "Batang" TitleFontName = value Exit Function UseDefault: TitleFontName = "Batang" End Function Private Function BodyFontName() As String On Error GoTo UseDefault Dim value As String value = Trim(txtBodyFontName.text) If value = "" Then value = "Batang" BodyFontName = value Exit Function UseDefault: BodyFontName = "Batang" End Function Private Function DateFontName() As String On Error GoTo UseDefault Dim value As String value = Trim(txtDateFontName.text) If value = "" Then value = "Batang" DateFontName = value Exit Function UseDefault: DateFontName = "Batang" End Function Private Function OrgFontName() As String On Error GoTo UseDefault Dim value As String value = Trim(txtOrgFontName.text) If value = "" Then value = "Batang" OrgFontName = value Exit Function UseDefault: OrgFontName = "Batang" End Function Private Function TitleBoldEnabled() As Boolean On Error GoTo UseDefault TitleBoldEnabled = CBool(chkTitleBold.value) Exit Function UseDefault: TitleBoldEnabled = True End Function Private Function BodyBoldEnabled() As Boolean On Error GoTo UseDefault BodyBoldEnabled = CBool(chkBodyBold.value) Exit Function UseDefault: BodyBoldEnabled = False End Function Private Function DateBoldEnabled() As Boolean On Error GoTo UseDefault DateBoldEnabled = CBool(chkDateBold.value) Exit Function UseDefault: DateBoldEnabled = False End Function Private Function OrgBoldEnabled() As Boolean On Error GoTo UseDefault OrgBoldEnabled = CBool(chkOrgBold.value) Exit Function UseDefault: OrgBoldEnabled = True End Function ' ========================================================================= ' 8. 워드 파일 생성 및 프린터 출력 엔진 ' ========================================================================= Private Function BuildReportDocument() As Document On Error GoTo BuildError If Trim(PreviewText(txtEmpName, "")) = "" Then MsgBox WriterNameRequiredMessage(), vbExclamation Set BuildReportDocument = Nothing Exit Function End If SaveData Dim finalBody As String finalBody = Replace(Replace(PreviewText(txtBody, ""), vbCrLf, vbLf), vbCr, vbLf) Application.ScreenUpdating = False Dim doc As Document Set doc = Documents.Add(Visible:=False) With doc.PageSetup .PaperSize = wdPaperA4 .TopMargin = MillimetersToPoints(25) .BottomMargin = MillimetersToPoints(25) .LeftMargin = MillimetersToPoints(25) .RightMargin = MillimetersToPoints(25) End With Dim reportLines As Collection Dim reportAligns As Collection Dim reportSizes As Collection Dim reportFonts As Collection Dim reportBolds As Collection Dim reportSpacings As Collection Dim reportParaKeys As Collection Set reportLines = New Collection Set reportAligns = New Collection Set reportSizes = New Collection Set reportFonts = New Collection Set reportBolds = New Collection Set reportSpacings = New Collection Set reportParaKeys = New Collection Dim titleSize As Long, bodySize As Long, dateSize As Long, orgSize As Long titleSize = PreviewNumber(txtTitleSize, 34, 8, 80) bodySize = PreviewNumber(txtBodySize, 14, 8, 40) dateSize = PreviewNumber(txtDateSize, 16, 8, 40) orgSize = PreviewNumber(txtOrgSize, 42, 8, 90) Dim titleSpc As Long Dim orgSpc As Long Dim titleFont As String Dim bodyFont As String Dim dateFont As String Dim orgFont As String Dim titleBold As Boolean Dim bodyBold As Boolean Dim dateBold As Boolean Dim orgBold As Boolean titleSpc = PreviewNumber(txtTitleSpacing, 7, -20, 100) orgSpc = PreviewNumber(txtOrgSpacing, 7, -20, 100) titleFont = TitleFontName() bodyFont = BodyFontName() dateFont = DateFontName() orgFont = OrgFontName() titleBold = TitleBoldEnabled() bodyBold = BodyBoldEnabled() dateBold = DateBoldEnabled() orgBold = OrgBoldEnabled() AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, Trim(PreviewText(txtDocTitle, DefaultDocTitle())), wdAlignParagraphCenter, titleSize, titleFont, titleBold, titleSpc, "Title" AddPreviewBlankLines reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewNumber(txtSpaceTB, 1, 0, 20), bodyFont, "GapTB" Dim bodyLines As Variant Dim i As Long If Len(finalBody) = 0 Then AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, "", wdAlignParagraphLeft, bodySize, bodyFont, bodyBold, 0, "Body" Else bodyLines = Split(finalBody, vbLf) For i = LBound(bodyLines) To UBound(bodyLines) AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, CStr(bodyLines(i)), wdAlignParagraphLeft, bodySize, bodyFont, bodyBold, 0, "Body" Next i End If AddPreviewBlankLines reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewNumber(txtSpaceBD, 3, 0, 20), bodyFont, "GapBD" AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewText(txtReportDate, ""), wdAlignParagraphRight, dateSize, dateFont, dateBold, 0, "Date" AddPreviewBlankLines reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewNumber(txtSpaceDS, 0, 0, 20), dateFont, "GapDS" AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, Trim(PreviewText(txtRank, "") & " " & PreviewText(txtEmpName, "") & " " & SignatureLabel()), wdAlignParagraphRight, dateSize, dateFont, dateBold, 0, "Sign" AddPreviewBlankLines reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewNumber(txtSpaceSO, 2, 0, 20), orgFont, "GapSO" AddPreviewLine reportLines, reportAligns, reportSizes, reportFonts, reportBolds, reportSpacings, reportParaKeys, PreviewText(txtOrgName, DefaultOrgName()), wdAlignParagraphCenter, orgSize, orgFont, orgBold, orgSpc, "Org" Dim reportTextValue As String For i = 1 To reportLines.count reportTextValue = reportTextValue & CStr(reportLines(i)) If i < reportLines.count Then reportTextValue = reportTextValue & vbCr End If Next i Dim target As Range Set target = doc.Range(0, doc.Content.End - 1) target.text = reportTextValue Set target = doc.Range(0, Len(reportTextValue)) For i = 1 To reportLines.count If i <= target.Paragraphs.count Then ApplyPreviewParagraphStyle target.Paragraphs(i).Range, CLng(reportAligns(i)), CLng(reportSizes(i)), CStr(reportFonts(i)), CBool(reportBolds(i)), CSng(reportSpacings(i)), CStr(reportParaKeys(i)) End If Next i Application.ScreenUpdating = True Set BuildReportDocument = doc Exit Function BuildError: Application.ScreenUpdating = True On Error Resume Next If Not doc Is Nothing Then doc.Close SaveChanges:=wdDoNotSaveChanges MsgBox BuildReportErrorMessage(Err.Description), vbExclamation Set BuildReportDocument = Nothing End Function Private Sub btnGenerate_Click() On Error GoTo GenerateError Dim doc As Document Set doc = BuildReportDocument() If doc Is Nothing Then Exit Sub Dim saveFolder As String saveFolder = Trim(PreviewText(txtSavePath, "")) If saveFolder = "" Or Dir(saveFolder, vbDirectory) = "" Then saveFolder = Options.DefaultFilePath(wdDocumentsPath) End If If Right(saveFolder, 1) <> Application.PathSeparator Then saveFolder = saveFolder & Application.PathSeparator Dim reportTitle As String, reportDate As String, reportRank As String, reportName As String reportTitle = SafeFileNameText(Trim(PreviewText(txtDocTitle, DefaultDocTitle()))) reportDate = SafeFileNameText(Replace(PreviewText(txtReportDate, Format(Date, "yyyymmdd")), ".", "")) reportRank = SafeFileNameText(Trim(PreviewText(txtRank, ""))) reportName = SafeFileNameText(Trim(PreviewText(txtEmpName, ""))) Dim defaultFileName As String defaultFileName = reportDate & " " & reportTitle & " " & reportRank & " " & reportName & ".docx" Dim userFileName As String userFileName = InputBox("저장할 파일 이름을 확인하거나 직접 입력하세요.", "보고서 파일명 설정", defaultFileName) If StrPtr(userFileName) = 0 Or Trim(userFileName) = "" Then doc.Close SaveChanges:=wdDoNotSaveChanges Exit Sub End If userFileName = Trim(userFileName) If LCase(Right(userFileName, 5)) <> ".docx" Then userFileName = userFileName & ".docx" userFileName = SafeFileNameText(userFileName) Dim finalSavePath As String finalSavePath = saveFolder & userFileName If Dir(finalSavePath) <> "" Then Dim baseName As String, extName As String, dotPos As Long, fileIndex As Long dotPos = InStrRev(userFileName, ".") baseName = left(userFileName, dotPos - 1) extName = Mid(userFileName, dotPos) fileIndex = 1 Do While Dir(saveFolder & baseName & "_" & fileIndex & extName) <> "" fileIndex = fileIndex + 1 Loop finalSavePath = saveFolder & baseName & "_" & fileIndex & extName End If doc.SaveAs2 fileName:=finalSavePath, FileFormat:=wdFormatXMLDocument doc.Close SaveChanges:=wdDoNotSaveChanges Application.ScreenUpdating = True MsgBox GenerateSuccessMessage(Mid(finalSavePath, InStrRev(finalSavePath, Application.PathSeparator) + 1), finalSavePath), vbInformation Exit Sub GenerateError: Application.ScreenUpdating = True On Error Resume Next If Not doc Is Nothing Then doc.Close SaveChanges:=wdDoNotSaveChanges MsgBox GenerateErrorMessage(Err.Description), vbExclamation End Sub Private Sub btnPrint_Click() On Error GoTo PrintError Dim doc As Document Dim printerName As String On Error Resume Next printerName = Application.ActivePrinter On Error GoTo PrintError If Trim(printerName) = "" Then MsgBox "기본 프린터를 찾을 수 없습니다." & vbCrLf & _ "Windows 설정에서 기본 프린터를 지정한 뒤 다시 시도하세요.", vbExclamation Exit Sub End If Set doc = BuildReportDocument() If doc Is Nothing Then Exit Sub doc.Repaginate doc.PrintOut Background:=False doc.Close SaveChanges:=wdDoNotSaveChanges Application.ScreenUpdating = True MsgBox Trim(txtDocTitle.text) & " 출력을 프린터로 전송했습니다." & vbCrLf & _ "프린터: " & printerName, vbInformation Exit Sub PrintError: Dim errText As String errText = Err.Description Application.ScreenUpdating = True On Error Resume Next If Not doc Is Nothing Then doc.Close SaveChanges:=wdDoNotSaveChanges On Error GoTo 0 MsgBox PrintErrorMessage(printerName, errText), vbExclamation End Sub ' --------------------------------------------------------- ' [기타 헬퍼 유틸리티 함수] ' --------------------------------------------------------- Private Function SafeFileNameText(ByVal value As String) As String Dim badChars As Variant Dim badChar As Variant badChars = Array("\", "/", ":", "*", "?", Chr$(34), "<", ">", "|") For Each badChar In badChars value = Replace(value, CStr(badChar), "_") Next badChar SafeFileNameText = Trim(Replace(Replace(value, vbCr, ""), vbLf, "")) End Function Private Function WriterNameRequiredMessage() As String WriterNameRequiredMessage = ChrW$(&HC791) & ChrW$(&HC131) & ChrW$(&HC790) & " " & ChrW$(&HC131) & ChrW$(&HBA85) & ChrW$(&HC744) & " " & ChrW$(&HC785) & ChrW$(&HB825) & ChrW$(&HD574) & ChrW$(&HC8FC) & ChrW$(&HC131) & ChrW$(&HC694) & "." End Function Private Function BuildReportErrorMessage(ByVal d As String) As String BuildReportErrorMessage = ChrW$(&HBCF4) & ChrW$(&HACE0) & ChrW$(&HC11C) & " " & ChrW$(&HC0DD) & ChrW$(&HC131) & " " & ChrW$(&HC911) & " " & ChrW$(&HC624) & ChrW$(&HB958) & ChrW$(&HAC00) & " " & ChrW$(&HBC1C) & ChrW$(&HC0DD) & ChrW$(&HD588) & ChrW$(&HC2B5) & ChrW$(&HB2C8) & ChrW$(&HB2E4) & "." & vbCrLf & d End Function Private Function GenerateErrorMessage(ByVal d As String) As String GenerateErrorMessage = ChrW$(&HD30C) & ChrW$(&HC77C) & " " & ChrW$(&HC800) & ChrW$(&HC7A5) & " " & ChrW$(&HC911) & " " & ChrW$(&HC624) & ChrW$(&HB958) & ChrW$(&HAC00) & " " & ChrW$(&HBC1C) & ChrW$(&HC0DD) & ChrW$(&HD588) & ChrW$(&HC2B5) & ChrW$(&HB2C8) & ChrW$(&HB2E4) & "." & vbCrLf & d End Function Private Function PrintErrorMessage(ByVal printerName As String, ByVal d As String) As String If Trim(printerName) = "" Then printerName = "(확인 안 됨)" If Trim(d) = "" Then d = "Word에서 자세한 오류 내용을 반환하지 않았습니다." PrintErrorMessage = "인쇄 중 오류가 발생했습니다." & vbCrLf & _ "프린터: " & printerName & vbCrLf & _ "오류 내용: " & d & vbCrLf & vbCrLf & _ "다른 컴퓨터에서만 안 되면 기본 프린터 지정, 프린터 드라이버 설치, 네트워크 프린터 연결/오프라인 상태, Word에서 직접 인쇄 가능 여부를 먼저 확인하세요." End Function Private Function GenerateSuccessMessage(ByVal t As String, ByVal p As String) As String GenerateSuccessMessage = t & " " & ChrW$(&HD30C) & ChrW$(&HC77C) & ChrW$(&HC774) & " " & ChrW$(&HC131) & ChrW$(&HACF5) & ChrW$(&HC801) & ChrW$(&HC73C) & ChrW$(&HB85C) & " " & ChrW$(&HC0DD) & ChrW$(&HB418) & ChrW$(&HC5C8) & ChrW$(&HC2B5) & ChrW$(&HB2C8) & ChrW$(&HB2E4) & "!" & vbCrLf & vbCrLf & ChrW$(&HC800) & ChrW$(&HC7A5) & " " & ChrW$(&HC704) & ChrW$(&HCE58) & ": " & p End Function Private Function AddLabel(parent As Object, name As String, caption As String, left As Single, top As Single) As MSForms.Label Set AddLabel = parent.Controls.Add("Forms.Label.1", name, True) AddLabel.caption = caption AddLabel.left = left AddLabel.top = top AddLabel.Font.name = "맑은 고딕" AddLabel.Font.Size = 11 AddLabel.WordWrap = False AddLabel.AutoSize = True End Function Private Function AddTextBox(parent As Object, name As String, text As String, left As Single, top As Single, width As Single, height As Single, Optional multi As Boolean = False) As MSForms.TextBox Set AddTextBox = parent.Controls.Add("Forms.TextBox.1", name, True) AddTextBox.text = text AddTextBox.Move left, top, width, height AddTextBox.Font.name = "맑은 고딕" AddTextBox.Font.Size = 11 If multi Then AddTextBox.Multiline = True AddTextBox.EnterKeyBehavior = True AddTextBox.ScrollBars = 2 End If End Function Private Function AddButton(parent As Object, name As String, caption As String, left As Single, top As Single, width As Single, height As Single) As MSForms.CommandButton Set AddButton = parent.Controls.Add("Forms.CommandButton.1", name, True) AddButton.caption = caption AddButton.Move left, top, width, height AddButton.Font.name = "맑은 고딕" AddButton.Font.Size = 10 AddButton.WordWrap = False End Function