엑셀에서 하이퍼링크 걸기

특별한 것은 없는데 중간에 하이퍼링크 거는 방법을 참고하시라고 올려봅니다.

Sub extractWord()

'

' Macro1 Macro

'

    '변수 선언 integer 는 32767 까지의 값만을 지원한다.

    Dim i As Integer

    Dim maxVal As Integer

    Dim startVal As Integer

    Dim nextVal As Integer

    Dim fileCnt As Integer           ' 파일의 수

    Dim sheetCnt As Integer     ' 파일의 시트 수

    Dim sNo As Integer          ' 처리한 시트 수

    Dim cellPnt As Integer

    Dim rowCnt As Integer

    Dim colCnt As Integer

    

    Dim f_name As String        '읽고자 하는 파일명

    Dim t_name As String        '매핑정의서에 기재된 소스테이블명

    Dim file_name As String      '파일명 전체

    Dim targetWord As String   '찾고자하는 단어명

    Dim cellVal As String       '단어를 찾은 셀의 내용

    

    '변수 기본값 할당

    i = 9           ' 첫 파일명이 세번째 줄에 있음.

    cellPnt = 2     ' 두번째 줄부터 써야 함.

    maxVal = 0      '   초기화

    startVal = 1    ' 파일 찾기 시작

    nextVal = 0     '   초기화

    

    '처리할 시트의 위치

    startSht = Cells(1, 2).Value

    jobName = Cells(2, 2).Value

    sColVal = Cells(1, 4).Value

    sRowVal = Cells(1, 6).Value

    eColVal = Cells(2, 4).Value

    eRowVal = Cells(2, 6).Value

    titleVal = Cells(2, 10).Value

    

    ' 시트를 새로 만든다.

    orgBookName = ActiveWorkbook.Name

    

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = jobName & Date & Hour(Time) & Minute(Time) & Second(Time)

    

    Cells(1, 4).Activate

    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C:R[3000]C)"

    

    '반복하며 파일 처리 함

        sNo = 1

        ' 파일열기

        d_name = Sheets("fileSheet").Cells(i, 2).Value

        f_name = Sheets("fileSheet").Cells(i, 3).Value

        

        file_name = d_name + f_name

    

        Dim fs, f, s

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFile(file_name)

        

            Workbooks.Open Filename:=file_name

            

            sheetCnt = ActiveWorkbook.Sheets.Count

    

    '        '시트 수 만큼 반복하며 확인할 것

        

            

            Do While sNo <= sheetCnt

                If sNo < startSht Then

                Else

                    

                    Workbooks(f_name).Activate

                    If Sheets(sNo).Visible = xlSheetVisible Then

                        Sheets(sNo).Select

                        sName = Sheets(sNo).Name

                        

                        If sNo = startSht Then

                            Range(Cells(sColVal - titleVal, sRowVal), Cells(eColVal, eRowVal)).Select

                        Else

                            Range(Cells(sColVal, sRowVal), Cells(eColVal, eRowVal)).Select

                        End If

                        Selection.Copy

                        

                        '확인된 시트명을 결과시트에 적기

                        

                        Workbooks(orgBookName).Activate

                        

                        If sNo = startSht Then

                            ActiveSheet.Cells(cellPnt + titleVal, 1).Value = sNo

                            anchorinfo = file_name + "#'" + sName + "'!A1"

                            ActiveSheet.Hyperlinks.Add Anchor:=Cells(cellPnt + titleVal, 3), Address:=anchorinfo, TextToDisplay:=sName

                        Else

                            ActiveSheet.Cells(cellPnt, 1).Value = sNo

                            anchorinfo = file_name + "#'" + sName + "'!A1"

                            ActiveSheet.Hyperlinks.Add Anchor:=Cells(cellPnt, 3), Address:=anchorinfo, TextToDisplay:=sName

                        End If

                        Cells(cellPnt, 4).Select

                        ActiveSheet.Paste

                                                

                        lastRow = Cells(1, 4).Value

                                        

                        If sNo = startSht Then

                            ActiveSheet.Cells(cellPnt + titleVal, 2).Value = lastRow - (titleVal)

                        

                            Range(Cells(cellPnt + titleVal, 1), Cells(cellPnt + titleVal, 3)).Copy

                            Range(Cells(cellPnt + titleVal + 1, 1), Cells(lastRow - cellPnt + 3, 3)).Select

                            ActiveSheet.Paste

                        

                        Else

                            pgmCnt = lastRow - cellPnt + 2

                            ActiveSheet.Cells(cellPnt, 2).Value = pgmCnt

                        

                            Range(Cells(cellPnt, 1), Cells(cellPnt, 3)).Copy

                            Range(Cells(cellPnt + 1, 1), Cells(cellPnt + pgmCnt - 1, 3)).Select

                            ActiveSheet.Paste

                        

                        

                        End If

                        

                        cellPnt = lastRow + 2

                           

                           

                           

                    End If

                End If

                sNo = sNo + 1

            Loop

         

            '파일 닫기

            Application.DisplayAlerts = False

            Workbooks(f_name).Close SaveChanges:=False

            

         i = i + 1

    

    Cells(titleVal + 1, 1).Value = "시트번호"

    Cells(titleVal + 1, 2).Value = "프로그램목록 수"

    Cells(titleVal + 1, 3).Value = "시트명"

    

    Rows("2:3000").Select

    Selection.RowHeight = 16.5

    

    Cells(titleVal + 2, 4).Select

    ActiveWindow.FreezePanes = True

    

    Sheets(2).Range(Cells(titleVal + 1, 1), Cells(titleVal + 1, 38)).Select

    Selection.AutoFilter

    

    Cells(1, 7).Select

                

'    ActiveWorkbook.SaveAs Filename:="c:\temp\test.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWorkbook.Save

                

    MsgBox ("작업을 완료하였습니다.")

    

End Sub