excel / VBA / macro / 선택값으로 sheet 추가

재물조사_품목규격서.xlsm

0.24MB

Sub 추가_Click()

  'Sheet2를 Sheet1 앞에다 복사하기

  

'Worksheets("form").Copy After:=Worksheets("form")

 

    Dim rngCnt As Integer

    Dim rngColCnt As Integer

    Dim sRow As Integer

    Dim eRow As Integer

        

    Dim sCol As Integer

        

    Dim rngEnd As Range

    Dim rng As Range: Set rng = Selection  '// 선택된 영역

    

    

     

    rngCnt = Selection.Rows.Count  '// 선택된 영역의 총 Row 수

    rngColCnt = Selection.Columns.Count  '// 선택된 영역의 총 Row 수

    sRow = Selection.Row  '// 선택된 영역의 첫번째 행의 위치 반환  절대값 row

    sCol = Selection.Column  '// 선택된 영역의 첫번째 col의 위치 반환

    eRow = Selection.Row + Selection.Rows.Count - 1  '// 선택된 영역의 마지막 행 위치 반환

    

    'MsgBox "첫번째 행은 " & sRow & "마지막 행은 " & eRow & "전체 선택한 행의 수는 " & rngCnt

    'MsgBox "첫번째 col은 " & sCol

    'MsgBox "마지막 행은 " & eRow

    'MsgBox "전체 선택한 행의 수는 " & rngCnt

 

    Dim strFileDir As String

    

    strFileDir = "c:\temp\"

 

    If rngColCnt <> 57 Then

 

        MsgBox "A열 ~BE열 을 선택하세요. (57개열)"

 

    Else

 

        ''MsgBox "There are " & rngColCnt & " items."

        

            '선택한 row만큼 반복

            Dim i As Integer

            Dim strTestNo      As String   '//순번

            Dim strTestTitle   As String   '//물품명

 

            Dim strA           As String   '//A열값입력

            Dim strB           As String   '//B열값입력

            Dim strC           As String   '//C열값입력

            Dim strD           As String   '//D열값입력

            Dim strE           As String   '//E열값입력

            Dim strF           As String   '//F열값입력

            Dim strG           As String   '//G열값입력

            Dim strH           As String   '//H열값입력

            Dim strI           As String   '//I열값입력

            Dim strJ           As String   '//J열값입력

            Dim strK           As String   '//K열값입력

            Dim strL           As String   '//L열값입력

            Dim strM           As String   '//M열값입력

            Dim strN           As String   '//N열값입력

            Dim strO           As String   '//O열값입력

            Dim strP           As String   '//P열값입력

            Dim strQ           As String   '//Q열값입력

            Dim strR           As String   '//R열값입력

            Dim strS           As String   '//S열값입력

            Dim strT           As String   '//T열값입력

            Dim strU           As String   '//U열값입력

            Dim strV           As String   '//V열값입력

            Dim strW           As String   '//W열값입력

            Dim strX           As String   '//X열값입력

            Dim strY           As String   '//Y열값입력

            Dim strZ           As String   '//Z열값입력

            Dim strAA           As String   '//AA열값입력

            Dim strAB           As String   '//AB열값입력

            Dim strAC           As String   '//AC열값입력

            Dim strAD           As String   '//AD열값입력

            Dim strAE           As String   '//AE열값입력

            Dim strAF           As String   '//AF열값입력

            Dim strAG           As String   '//AG열값입력

            Dim strAH           As String   '//AH열값입력

            Dim strAI           As String   '//AI열값입력

            Dim strAJ           As String   '//AJ열값입력

            Dim strAK           As String   '//AK열값입력

            Dim strAL           As String   '//AL열값입력

            Dim strAM           As String   '//AM열값입력

            Dim strAN           As String   '//AN열값입력

            Dim strAO           As String   '//AO열값입력

            Dim strAP           As String   '//AP열값입력

            Dim strAQ           As String   '//AQ열값입력

            Dim strAR           As String   '//AR열값입력

            Dim strAS           As String   '//AS열값입력

            Dim strAT           As String   '//AT열값입력

            Dim strAU           As String   '//AU열값입력

            Dim strAV           As String   '//AV열값입력

            Dim strAW           As String   '//AW열값입력

            Dim strAX           As String   '//AX열값입력

            Dim strAY           As String   '//AY열값입력

            Dim strAZ           As String   '//AZ열값입력

            Dim strBA           As String   '//BA열값입력

            Dim strBB           As String   '//BB열값입력

            Dim strBC           As String   '//BC열값입력

            Dim strBD           As String   '//BD열값입력

            Dim strBE           As String   '//BE열값입력

 

 

            Dim img As Variant

        

            'img = Application.GetOpenFilename(filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif;*.png")

    

            

            '시트추가

            '존재여부확인후 추가

            For i = 1 To rng.Rows.Count

                

                strTestNo = sRow + i - 1 '선택한 해당 row값을 sheet명으로 함

 

                strA = rng(i, 1) 'rng.Cells(sRow, "A").Value

                strB = rng(i, 2) 'rng.Cells(sRow, "B").Value

                strC = rng(i, 3) 'rng.Cells(sRow, "C").Value

                strD = rng(i, 4) 'rng.Cells(sRow, "D").Value

                strE = rng(i, 5) 'rng.Cells(sRow, "E").Value

                strF = rng(i, 6) 'rng.Cells(sRow, "F").Value

                strG = rng(i, 7) 'rng.Cells(sRow, "G").Value

                strH = rng(i, 8) 'rng.Cells(sRow, "H").Value

                strI = rng(i, 9) 'rng.Cells(sRow, "I").Value

                strJ = rng(i, 10) 'rng.Cells(sRow, "J").Value

                strK = rng(i, 11) 'rng.Cells(sRow, "K").Value

                strL = rng(i, 12) 'rng.Cells(sRow, "L").Value

                strM = rng(i, 13) 'rng.Cells(sRow, "M").Value

                strN = rng(i, 14) 'rng.Cells(sRow, "N").Value

                strO = rng(i, 15) 'rng.Cells(sRow, "O").Value

                strP = rng(i, 16) 'rng.Cells(sRow, "P").Value

                strQ = rng(i, 17) 'rng.Cells(sRow, "Q").Value

                strR = rng(i, 18) 'rng.Cells(sRow, "R").Value

                strS = rng(i, 19) 'rng.Cells(sRow, "S").Value

                strT = rng(i, 20) 'rng.Cells(sRow, "T").Value

                strU = rng(i, 21) 'rng.Cells(sRow, "U").Value

                strV = rng(i, 22) 'rng.Cells(sRow, "V").Value

                strW = rng(i, 23) 'rng.Cells(sRow, "W").Value

                strX = rng(i, 24) 'rng.Cells(sRow, "X").Value

                strY = rng(i, 25) 'rng.Cells(sRow, "Y").Value

                strZ = rng(i, 26) 'rng.Cells(sRow, "Z").Value

                strAA = rng(i, 27) 'rng.Cells(sRow, "AA").Value

                strAB = rng(i, 28) 'rng.Cells(sRow, "AB").Value

                strAC = rng(i, 29) 'rng.Cells(sRow, "AC").Value

                strAD = rng(i, 30) 'rng.Cells(sRow, "AD").Value

                strAE = rng(i, 31) 'rng.Cells(sRow, "AE").Value

                strAF = rng(i, 32) 'rng.Cells(sRow, "AF").Value

                strAG = rng(i, 33) 'rng.Cells(sRow, "AG").Value

                strAH = rng(i, 34) 'rng.Cells(sRow, "AH").Value

                strAI = rng(i, 35) 'rng.Cells(sRow, "AI").Value

                strAJ = rng(i, 36) 'rng.Cells(sRow, "AJ").Value

                strAK = rng(i, 37) 'rng.Cells(sRow, "AK").Value

                strAL = rng(i, 38) 'rng.Cells(sRow, "AL").Value

                strAM = rng(i, 39) 'rng.Cells(sRow, "AM").Value

                strAN = rng(i, 40) 'rng.Cells(sRow, "AN").Value

                strAO = rng(i, 41) 'rng.Cells(sRow, "AO").Value

                strAP = rng(i, 42) 'rng.Cells(sRow, "AP").Value

                strAQ = rng(i, 43) 'rng.Cells(sRow, "AQ").Value

                strAR = rng(i, 44) 'rng.Cells(sRow, "AR").Value

                strAS = rng(i, 45) 'rng.Cells(sRow, "AS").Value

                strAT = rng(i, 46) 'rng.Cells(sRow, "AT").Value

                strAU = rng(i, 47) 'rng.Cells(sRow, "AU").Value

                strAV = rng(i, 48) 'rng.Cells(sRow, "AV").Value

                strAW = rng(i, 49) 'rng.Cells(sRow, "AW").Value

                strAX = rng(i, 50) 'rng.Cells(sRow, "AX").Value

                strAY = rng(i, 51) 'rng.Cells(sRow, "AY").Value

                strAZ = rng(i, 52) 'rng.Cells(sRow, "AZ").Value

                strBA = rng(i, 53) 'rng.Cells(sRow, "BA").Value

                strBB = rng(i, 54) 'rng.Cells(sRow, "BB").Value

                strBC = rng(i, 55) 'rng.Cells(sRow, "BC").Value

                strBD = rng(i, 56) 'rng.Cells(sRow, "BD").Value

                strBE = rng(i, 57) 'rng.Cells(sRow, "BE").Value

 

                

           

            

            

                

                '시트추가 관련

                If worksheet_exists(strTestNo) Then

                    MsgBox strTestNo & " 시트존재"

                Else

                    'MsgBox "없음"

                    'Debug.Print strTestNo  '시험번호

                    'Debug.Print strTestTitle  '시험제목

                     

                If Trim(strTestNo) = "" Then

                    MsgBox "순번이 공백입니다."

                Else

                     

                    '시트추가

                      Worksheets("FORM").Copy After:=Worksheets(Sheets.Count)  '제일끝에 추가

    

                    '시트명 변경

                    Sheets(Sheets.Count).name = Trim(strTestNo)

 

                    '추가한 시트에 값 입력

                    Sheets(Sheets.Count).Range("B2").Value = strA   'A열   취득일자(B2)

                    Sheets(Sheets.Count).Range("F2").Value = strB   'B열  제정일자(F2)

                    Sheets(Sheets.Count).Range("B3").Value = strC   'C열  규격번호(B3)

                    Sheets(Sheets.Count).Range("F3").Value = strD   'D열  폐지일자(F3)

                    

                    Sheets(Sheets.Count).Range("B4").Value = strE   'E열   □자산구분(비유동,부외)

                    Sheets(Sheets.Count).Range("B6").Value = strH   'H열   대분류명

                    Sheets(Sheets.Count).Range("F6").Value = strJ   'J열   중

                    Sheets(Sheets.Count).Range("B7").Value = strL   'L열   소

                    Sheets(Sheets.Count).Range("F7").Value = strN   'N열   세

                    

                    Sheets(Sheets.Count).Range("B8").Value = strP   'P열   품명

                    Sheets(Sheets.Count).Range("B9").Value = strR   'R열   품목

                    Sheets(Sheets.Count).Range("B10").Value = strS   'S열   형태

                    Sheets(Sheets.Count).Range("F10").Value = strT   'T열   재질

                    Sheets(Sheets.Count).Range("B11").Value = strU   'U열   색상

                    Sheets(Sheets.Count).Range("F11").Value = strV   'V열   제조사

                    'Sheets(Sheets.Count).Range("B30").Value = strW   'W열   비품지급등급공통

                    'Sheets(Sheets.Count).Range("B30").Value = strX   'X열   S

                    'Sheets(Sheets.Count).Range("B30").Value = strY   'Y열   A

                    'Sheets(Sheets.Count).Range("B30").Value = strZ   'Z열   B1

                    'Sheets(Sheets.Count).Range("B30").Value = strAA   'AA열   B2

                    'Sheets(Sheets.Count).Range("B30").Value = strAB   'AB열   C

                    'Sheets(Sheets.Count).Range("B30").Value = strAC   'AC열   D

                    

                    Sheets(Sheets.Count).Range("F12").Value = strAD   'AD열   단위

                    Sheets(Sheets.Count).Range("B13").Value = strAE   'AE열   태그사이즈

                    Sheets(Sheets.Count).Range("G13").Value = strAF   'AF열   프로그램자산

 

                    Sheets(Sheets.Count).Range("B15").Value = strAG   'AG열   □계약정보계약일자(YYYYMMDD)

                    Sheets(Sheets.Count).Range("F15").Value = strAH   'AH열   수량

                    Sheets(Sheets.Count).Range("B16").Value = strAI   'AI열   상대방

                    'Sheets(Sheets.Count).Range("B30").Value = strAJ   'AJ열   계약체결통보서

 

                    Sheets(Sheets.Count).Range("B18").Value = strAK   'AK열   □검교정관리대상(Y ,N)

                    Sheets(Sheets.Count).Range("B30").Value = strAL   'AL열   방법

                    Sheets(Sheets.Count).Range("B30").Value = strAM   'AM열   주기단위

                    Sheets(Sheets.Count).Range("B30").Value = strAN   'AN열   주기

                    

                    Sheets(Sheets.Count).Range("B21").Value = strAO   'AO열   □태그관리태그종류

                    

                    Sheets(Sheets.Count).Range("B23").Value = strAP   'AP열   □세부사양1

                    Sheets(Sheets.Count).Range("B24").Value = strAQ   'AQ열   2

                    Sheets(Sheets.Count).Range("B25").Value = strAR   'AR열   3

                    Sheets(Sheets.Count).Range("B26").Value = strAS   'AS열   4

                    Sheets(Sheets.Count).Range("B27").Value = strAT   'AT열   5

                    Sheets(Sheets.Count).Range("F23").Value = strAU   'AU열   6

                    Sheets(Sheets.Count).Range("F24").Value = strAV   'AV열   7

                    Sheets(Sheets.Count).Range("F25").Value = strAW   'AW열   8

                    Sheets(Sheets.Count).Range("F26").Value = strAX   'AX열   9

                    Sheets(Sheets.Count).Range("F27").Value = strAY   'AY열   10

                    Sheets(Sheets.Count).Range("B28").Value = strAZ   'AZ열   폐기대상여부(Y/N)

                    

                    Sheets(Sheets.Count).Range("C28").Value = "현위치 : " & strBA & " -> 전환 : " & strBB   'BA열   위치현위치

                    'Sheets(Sheets.Count).Range("B30").Value = strBB   'BB열   전환위치

                    

                    'Sheets(Sheets.Count).Range("B30").Value = strBC   'BC열   파일1

                    'Sheets(Sheets.Count).Range("B30").Value = strBD   'BD열   2

                    'Sheets(Sheets.Count).Range("B30").Value = strBE   'BE열   3

 

    

    

                    'image입력

                    If Dir(strFileDir & strBC & ".jpg") <> "" Then

                        With ActiveSheet.Pictures.Insert(strFileDir & strBC & ".jpg").ShapeRange

                    

                            .LockAspectRatio = msoFalse

                    

                            .Height = 135 'A5.Height '선택한 영영의 높이

                    

                            .Width = 140 'A5.Width

                    

                            .Left = 10 'A5.Left

                    

                            .Top = 540 'A5.Top

                    

                        End With

                    End If

                    

                    

                    If Dir(strFileDir & strBD & ".jpg") <> "" Then

                        With ActiveSheet.Pictures.Insert(strFileDir & strBD & ".jpg").ShapeRange

                    

                            .LockAspectRatio = msoFalse

                    

                            .Height = 135 'A5.Height '선택한 영영의 높이

                    

                            .Width = 140 'A5.Width

                    

                            .Left = 150 'A5.Left

                    

                            .Top = 540 'A5.Top

                    

                        End With

                    End If

                    

                    If Dir(strFileDir & strBE & ".jpg") <> "" Then

                        With ActiveSheet.Pictures.Insert(strFileDir & strBE & ".jpg").ShapeRange

                    

                            .LockAspectRatio = msoFalse

                    

                            .Height = 135 'A5.Height '선택한 영영의 높이

                    

                            .Width = 140 'A5.Width

                    

                            .Left = 290 'A5.Left

                    

                            .Top = 540 'A5.Top

                    

                        End With

                    End If

                    

                

                End If

                                

                End If

                

 

            Next

            

 

 

            '활성화 시트명

             Worksheets("양식업로드용").Activate

 

 

    End If 'If rngColCnt <> 57 Then

 

    

 

 

End Sub

 

 

Function worksheet_exists(name)

    worksheet_exists = False

    For Each ws In ActiveWorkbook.Worksheets

        If ws.name = name Then worksheet_exists = True

    Next ws

End Function

 

 

 

 

 

 

Sub 이동_Click()

 

    Dim rngCnt As Integer

    Dim rngColCnt As Integer

    Dim sRow As Integer

    Dim eRow As Integer

        

    Dim sCol As Integer

        

    Dim rngEnd As Range

    Dim rng As Range: Set rng = Selection  '// 선택된 영역

    

    

     

    rngCnt = Selection.Rows.Count  '// 선택된 영역의 총 Row 수

    rngColCnt = Selection.Columns.Count  '// 선택된 영역의 총 Row 수

    sRow = Selection.Row  '// 선택된 영역의 첫번째 행의 위치 반환

    sCol = Selection.Column  '// 선택된 영역의 첫번째 col의 위치 반환

    eRow = Selection.Row + Selection.Rows.Count - 1  '// 선택된 영역의 마지막 행 위치 반환

    

    'MsgBox "첫번째 행은 " & sRow & "마지막 행은 " & eRow & "전체 선택한 행의 수는 " & rngCnt

    'MsgBox "첫번째 col은 " & sCol

    'MsgBox "마지막 행은 " & eRow

    'MsgBox "전체 선택한 행의 수는 " & rngCnt

    

    Dim strTestNo As String

    Dim strTestTitle As String

            

            

     Debug.Print rngColCnt & "_" & sCol & "_" & sRow '시험제목

    

    If rngColCnt >= 1 And sCol = 1 Then

 

        strTestNo = sRow '순번

        

        'MsgBox "시험번호 선택, (1개열) ok "

         Debug.Print strTestNo

        

         If worksheet_exists(strTestNo) Then

             

                 '활성화 시트명

                 Worksheets(strTestNo).Activate

 

         Else

             MsgBox "[" & strTestNo & "]시트 없음"

         

         End If

         

    Else

 

        MsgBox "순번을 선택하세요. (1~7개열)"

    

    End If

    

    

End Sub

 

 

 

 

Function worksheet_exists(name)

    worksheet_exists = False

    For Each ws In ActiveWorkbook.Worksheets

        If ws.name = name Then worksheet_exists = True

    Next ws

End Function