목적 : 

다른 곳에 해당 엑셀을 배포시에 특정 시트는 숨김처리하고 보내야 할경우가 있다.

VBA 상에서 해당 시트를 숨김처리 한후에 VBA 자체를 암호를 걸면 해당 작업이 가능하다.

 

방법 :

1. 탭 숨김처리

: VBA 상에서

보기 -> 속성창(W) -> 숨김처리 하고자 하는 Sheet 선택 -> Visible -> 2 - xlSheetVeryHidden 선택

 

2. VBA 암호 걸기

: VBA 상에서

도구 -> VBAProject 속성 -> 보호 탭 -> 암호 걸기 -> 껐다 키기

 

참고 싸이트

https://mainia.tistory.com/1310

설정

트랙백

댓글

목적
: 엑셀 파일 생성 및 문자열에서 필요한 부분만 추출

실행결과
: 4,2 셀에 있는 값의 5부터 8개 글자의 파일명으로 추출해서 파일명 만든후 생성

코드


Sub create_file_device_string() 
    Dim template_sheet As Worksheet 
    Dim file_name As String 
     
    Set template_sht = Sheets("TEST") 
     
    file_name = Mid(template_sht.Rows(4).Columns(2).Value, 5, 8) '문자열 자르기 
     
    'F_name = file_name  'B열 1행의 값 -> F_name 변수지정 

    '생성할 파일이 이미존재하는지 여부확인 
    If Len(Dir(ThisWorkbook.Path & "\" & F_name & ".xlsx")) Then 
        ' 현 워크북 파일 디렉토리에 F_name 변수값의 엑셀파일이 있다면  True 
        MsgBox "파일명이 존재합니다."  '메시지 띄움 
         
    End If 

    Workbooks.Add  '워크북 추가 

    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & file_name & ".xlsx" 
    '현 디렉토리에 "file_name".xlsx 로 저장 
End Sub 

 

설정

트랙백

댓글

목적
: 엑셀 파일의 특정 시트를 출력하는 VBA
: 양식은 동일한데 내용을 바꿔가면서 출력할때 사용해도 좋음

실행결과
: 지정한 시트가 출력됨

코드

 

설정

트랙백

댓글

목적

: 특정 폴더내 모든 엑셀파일을 열어 마스터 파일의 시트를 복사후 저장하기

 

실행결과

: 폴더내 모든 파일내 동일 시트 복사됨

 

코드

Sub make_job_report()

    Application.DisplayAlerts = False  '경고 메시지 표시하지 않기

    Dim wb As Workbook
    Dim template_sheet, format_sheet As Worksheet
    Dim file_name As String
    Dim template_row As Integer, template_col As Integer
    Dim i, j, k As Integer
        
    Set format_sheet = Sheets("TEST") 'TEST 시트를 폴더내 다른 파일에 붙여 넣을 것임
    

    file_name = "TempFIle"
    
    
    Dim Filename, Pathname As String

    Dim wbOpen As Workbook

    Pathname = "D:\폴더\"

    Filename = Dir(Pathname & "*.xlsx")

    Do While Filename <> ""

        Set wbOpen = Workbooks.Open(Pathname & Filename) '새로 열 파일의 워크북

        format_sheet.Copy Before:=wbOpen.Sheets(1)

        wbOpen.Close SaveChanges:=True '작업 파일, 작업 후 저장. 저장하지 않을 경우 False

        Filename = Dir()

    Loop
    
End Sub

설정

트랙백

댓글

목적
: 각셀에 하이퍼 링크 파일을 걸어주기

실행결과
: 순환하면서 해당 셀의 값을 기초로 각 파일의 하이퍼 링크를 걸어준다.

코드


Sub hyperlinksub() 

    Dim wb As Workbook 
    Dim template_sheet, format_sheet, skill_sheet, jobdef_sheet As Worksheet 
    Dim pre_file_name, file_name, job_title, skill_value, jfg_value, vp_file_check As String 
    Dim template_row As Integer, template_col As Integer 
    Dim i, j, k, skill_length, skill_competency, skill_description, tb_value, tb1_col, end_num As Integer 
    Dim varTmp() As String 
    Dim skillTmp() As String 
         
    Set template_sht = Sheets("R&D") 
     
    template_row = template_sht.UsedRange.Rows.Count 
    template_col = template_sht.UsedRange.Columns.Count 
     
     
    For i = 3 To template_row 
        If Not IsEmpty(template_sht.Rows(i).Columns(8).Value) Then 
            file_name = Mid(template_sht.Rows(i).Columns(8).Value, 5, 9) 
            template_sht.Hyperlinks.Add Anchor:=template_sht.Rows(i).Columns(8), Address:="연구개발\" & file_name & ".xlsx" 
        End If 
    Next 
     
End Sub 

 

설정

트랙백

댓글

목적
: 포문 돌때 짝수만 돌기

실행결과
: For문의 짝수만 돌아서 진행

코드

    For i = 0 To UBound(varTemp) Step 2      '배열내 증가값을 2씩 한다. 
        format_sheet.Rows(format_similar_job + (i / 2)).Columns(3).Value = varTemp(i) 
        'i = i + 2 '짝수만 돌리기 
        MsgBox i 
    Next 



설정

트랙백

댓글

목적
: 엑셀 파일 생성 및 문자열에서 필요한 부분만 추출

실행결과
: 4,2 셀에 있는 값의 5부터 8개 글자의 파일명으로 추출해서 파일명 만든후 생성

코드

Sub create_file_device_string() 
    Dim template_sheet As Worksheet 
    Dim file_name As String 
     
    Set template_sht = Sheets("TEST") 
     
    file_name = Mid(template_sht.Rows(4).Columns(2).Value, 5, 8) '문자열 자르기 
 
    '생성할 파일이 이미존재하는지 여부확인 
    If Len(Dir(ThisWorkbook.Path & "\" & F_name & ".xlsx")) Then 
        ' 현 워크북 파일 디렉토리에 F_name 변수값의 엑셀파일이 있다면  True 
        MsgBox "파일명이 존재합니다."  '메시지 띄움 
         
    End If 

    Workbooks.Add  '워크북 추가 

    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & file_name & ".xlsx" 
    '현 디렉토리에 "file_name".xlsx 로 저장 
End Sub 



설정

트랙백

댓글

목적

: 다양한 문자열 들을 합치는 기능 구현

ex) A 와 B 라는 양식의 글들을 있을때 A(B) 라는 문자열로 모두 만들때


실행 결과

: B~차있는 열 까지의 문자들이 모두 합쳐져서 A 열에 나타나게 됨


코드

 Sub sum_string()

    Dim template_sht As Worksheet, position_sht As Worksheet, std_job_sht As Worksheet

    

    Set template_sht = Sheets("Data") '실제 Sheet 의 이름

    Dim template_row As Integer, template_col As Integer

    Dim temp_str As String

    Dim i As Integer, j As Integer

        

    template_row = template_sht.UsedRange.Rows.count

    template_col = template_sht.UsedRange.Columns.count


    For i = 1 To template_row

        

        temp_str = ""

        For j = 2 To template_col

            If IsEmpty(template_sht.Rows(i).Columns(j).Value) Then

            Else

                temp_str = temp_str & template_sht.Rows(i).Columns(j).Value

            End If

        Next j

        template_sht.Rows(i).Columns(1).Value = temp_str

    Next i

    

End Sub


설정

트랙백

댓글

목적

: 엑셀에서 특정한 시트 하나만 남기고 모두 삭제 or 원하는 시트만 남기고 모두 삭제하기


실행 결과

: 지정한 시트만 남고 모두 삭제됨


코드

Sub DeleteSheet()

    Dim xWs As Worksheet


Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each xWs In Application.ActiveWorkbook.Worksheets

If xWs.Name <> "Sheet1" And xWs.Name <> "남길시트이름" Then 'Sheet1 과 남길시트이름 두개만 남기고 모두 삭제됨

xWs.Delete

End If

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub


설정

트랙백

댓글

목적

: 엑셀 VBA(Excel VBA)를 사용하여 특정 폴더의 Excel 파일들을 열어 원하는 작업을 수행


실행 결과

: 폴더내의 모든 엑셀 파일을 순차적으로 열어서 지정한 작업들을 수행한 후에 저장한다.


코드

Sub ProcessFiles()   

    Application.DisplayAlerts = False  '경고 메시지 표시하지 않기

    

    Dim Filename, Pathname As String

    Dim wb As Workbook

    Pathname = "D:\FolderName\"

    Filename = Dir(Pathname & "*.xlsx")

        Do While Filename <> ""

            Set wb = Workbooks.Open(Pathname & Filename)

            DoWork wb

            wb.Close SaveChanges:=True '작업 파일,  작업 후 저장. 저장하지 않을 경우 False

            Filename = Dir()

        Loop

    Application.DisplayAlerts = True  '경고 메시지 표시하기

End Sub


Sub DoWork(wb As Workbook) 'DoWork 에서 매개변수 WorkBook(엑셀파일) 을 가져와서 작업 수행

    Dim raw_sht As Worksheet


    Dim xWs As Worksheet

    Dim i, j As Integer

    With wb

        '반복할 작업을 이곳에 넣는다.!

    End With

End Sub


설정

트랙백

댓글