CS관리 매크로 엑셀 템플릿 | SmartSpace KDM컨설팅

CS 방문자 정보 엑셀로 저장관리하기 위한 매크로 엑셀 템플릿 xlsm 샘플 파일. 각종 리더기와 연계해서 사용가능합니다.

다운로드한 xlsm파일 "매크로 포함" 오픈한다.
새로 시작하기 버튼 클릭하면 현재 화면에 보이는 모든 데이터 클리어한다.
저장하기 버튼을 클릭하면 현재 화면에 보여지는 정보를 xls 파일에 저장한다.
엑셀파일로 이런 파일명으로 같은 폴더에 생성한다. (예, "컴퓨터이름-사용자이름-YYYYMMDDHHmmss.xls")
누를때마다 현재시각 가져와서 새로운 파일로 계속 저장한다.

"저장하기" 버튼을 누르면 동작하는 매크로

Sub SaveSheet1AsNewFileAndSheet()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim newSheet As Worksheet
    Dim newFileName As String
    Dim folderPath As String
    Dim computerName As String
    Dim userName As String
    Dim currentDateTime As String
    Dim confirmation As VbMsgBoxResult
    
    ' 사용자에게 재확인 메시지 표시
    confirmation = MsgBox("저장하시겠습니까?", vbYesNo + vbQuestion, "저장 확인")
    
    ' 사용자가 확인을 선택하지 않으면 매크로 종료
    If confirmation <> vbYes Then Exit Sub
    
    ' 현재 시트를 참조합니다.
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 컴퓨터 이름, 사용자 이름, 현재 날짜 및 시간 포맷 설정
    computerName = Environ("COMPUTERNAME")
    userName = Environ("USERNAME")
    currentDateTime = Format(Now, "YYYYMMDDHHmmss")
    
    ' 저장할 파일 이름 설정
    newFileName = computerName & "-" & userName & "-" & currentDateTime & ".xls"
    
    ' 파일 저장 경로 (현재 파일이 있는 폴더에 저장)
    folderPath = ThisWorkbook.Path
    
    ' 새로운 워크북 생성
    Set newWb = Workbooks.Add
    
    ' 새로운 시트 추가
    Set newSheet = newWb.Sheets(1)
    newSheet.Name = computerName & "-" & userName & "-" & currentDateTime
    
    ' Sheet1의 내용 복사하여 새로운 시트에 붙여넣기
    ws.UsedRange.Copy Destination:=newSheet.Range("A1")
    
    ' 새로운 파일로 저장
    newWb.SaveAs Filename:=folderPath & "/" & newFileName, FileFormat:=xlWorkbookNormal
    newWb.Close False
    
    MsgBox "데이터가 새로운 파일 '" & newFileName & "'에 저장되었습니다.", vbInformation
End Sub


(아래는 참조용 디버깅중)
Sub SaveSheet1AsNewFileAndSheet()
Dim ws As Worksheet
Dim newWb As Workbook
Dim newSheet As Worksheet
Dim newFileName As String
Dim folderPath As String
Dim computerName As String
Dim userName As String
Dim currentDateTime As String
Dim confirmation As VbMsgBoxResult

' 사용자에게 재확인 메시지 표시
confirmation = MsgBox("저장하시겠습니까?", vbYesNo + vbQuestion, "저장 확인")

' 사용자가 확인을 선택하지 않으면 매크로 종료
If confirmation <> vbYes Then Exit Sub

' 현재 시트를 참조합니다.
Set ws = ThisWorkbook.Sheets("Sheet1")

' 컴퓨터 이름, 사용자 이름, 현재 날짜 및 시간 포맷 설정
On Error Resume Next ' 오류 무시하고 계속 진행
computerName = Environ("COMPUTERNAME")
userName = Environ("USERNAME")
On Error GoTo 0 ' 오류 처리 복원
If computerName = "" Then computerName = "UnknownComputer"
If userName = "" Then userName = "UnknownUser"
currentDateTime = Format(Now, "YYYYMMDDHHmmss")

' 저장할 파일 이름 설정
newFileName = computerName & "-" & userName & "-" & currentDateTime & ".xlsx"

' 파일 저장 경로 (현재 파일이 있는 폴더에 저장)
folderPath = ThisWorkbook.Path

' 새로운 워크북 생성
Set newWb = Workbooks.Add

' 새로운 시트 추가
Set newSheet = newWb.Sheets(1)
newSheet.Name = computerName & "-" & userName & "-" & currentDateTime

' Sheet1의 내용 복사하여 새로운 시트에 붙여넣기
ws.UsedRange.Copy Destination:=newSheet.Range("A1")

' 새로운 파일로 저장
newWb.SaveAs Filename:=folderPath & "\" & newFileName, FileFormat:=xlOpenXMLWorkbook
newWb.Close False

MsgBox "데이터가 새로운 파일 '" & newFileName & "'에 저장되었습니다.", vbInformation
End Sub

"새로 시작하기" 버튼을 누르면 동작하는 매크로

Sub ClearSheetData()
    Dim ws As Worksheet
    Dim confirmation As VbMsgBoxResult
    
    ' 사용자에게 재확인 메시지 표시
    confirmation = MsgBox("현재 시트의 모든 데이터를 삭제하시겠습니까?", vbYesNo + vbQuestion, "삭제 확인")
    
    ' 사용자가 확인을 선택하지 않으면 매크로 종료
    If confirmation <> vbYes Then Exit Sub
    
    ' 현재 시트를 참조합니다.
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 시트의 모든 데이터를 삭제합니다.
    ws.Cells.Clear 
    ws.Range("A1").Select
    
    MsgBox "현재 시트의 데이터가 삭제되었습니다.", vbInformation
End Sub

Leave a Comment 응답 취소