Hyper link Macro

Hyper link Macro

• Edmaneiro

  Hey Bootz,

  Do you like this

  FiftyFive

  Sub CreateDirLinks()
  Dim Tmp
  Dim DirName As String
  Dim DispText As String
  Dim Max As Long
  Max = 20
  Dim Idx As Long
  Application.ScreenUpdating = False
  With ThisWorkbook
  For Idx = 1 To Max
  With Sheets("100")
  .Activate
  .Cells(4 + Idx, 1).Select
  DispText = 100 + Idx
  DirName = "E:\Temp\" & DispText
  ActiveCell.Value = DispText
  Tmp = DirectoryExist(ActiveCell.Value, False, True) 'Check or create directory
  If Tmp(1) Then
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=DirName, _
  TextToDisplay:=DispText
  End If
  End With
  Next
  End With
  End Sub

  
  
  

• Bao Baboon

  Bootz

  Below just another example

  I give you the advice: make some investigation in a basic cource;-)

  and soon you will be an expert too

  BTW: what's your mission

  Regards, Fiftyfive

  Sub CreateDirLinks()
  Dim Tmp
  Dim DirName
  Dim Max As Long
  Dim Max0 As Long
  Dim MyAnchor As String
  Max0 = 12 'the first level
  Max = 10 'the 2nd level
  Dim Idx As Long
  Dim Idx0 As Long
  Application.ScreenUpdating = False
  With ThisWorkbook.Sheets("100") 'You can take any name
  For Idx0 = 1 To Max0
  For Idx = 1 To Max
  .Activate
  MyAnchor = Format(Idx + (Idx0 * 100), "0000")
  DirName = "E:\Temp\" & Format(Idx0 * 100, "0000") & "\" & MyAnchor
  ActiveCell.Value = DirName
  Tmp = DirectoryExist(ActiveCell.Value, False, True) 'Check or create directory
  If Tmp(1) Then
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=DirName, _
  TextToDisplay:=MyAnchor
  End If
  ActiveCell.Cells(2, 1).Select
  Next
  Next
  End With
  End Sub

  
  
  

• Steve Galic - MSFT

  Boots

  Below an example

  First create workbook with one sheet named "100"

  Run the macro and you have 101 sheets

  the links are in sheet "100"

  Suc6

  Sub CreateLinks()
  Dim Max As Long
  Max = 100
  Dim Idx As Long
  With ThisWorkbook
  For Idx = 1 To Max
  .Sheets.Add after:=Worksheets(Worksheets.Count)

  ActiveSheet.Name = 100 + Idx
  With Sheets("100")
  .Activate
  .Cells(1 + Idx, 1).Select
  ActiveCell.Value = 100 + Idx
  ActiveSheet.Hyperlinks.Add _
  Anchor:=Selection, Address:="", _
  SubAddress:=ActiveCell.Value & "!A1" ', TextToDisplay:="sheet1"
  End With
  Next
  End With
  End Sub

  Kind Regards

  FiftyFive

  
  
  

• kamran_kamaei

  Hi thanks very much for code, works well.

  Just one thing, can you make the text to be displayed the number of the folder eg100. ie 'Y:/100/' the text excel displays in the hyperlinked cell is 100.

  Had a play with the code myself, but could not work it out. I think i well start learning VB. Thanks again.

  
  

• erymuzuan

  Boots

  Another piece of code

  Kind regards

  FiftyFive

  Is this what you mean

  Sub CreateDirLinks()
  Dim Tmp
  Dim DirName
  Dim Max As Long
  Max = 100
  Dim Idx As Long
  Application.ScreenUpdating = False
  With ThisWorkbook
  For Idx = 1 To Max
  With Sheets("100")
  .Activate
  .Cells(1 + Idx, 1).Select
  DirName = "E:\Temp\" & 100 + Idx
  ActiveCell.Value = DirName
  Tmp = DirectoryExist(ActiveCell.Value, False, True) 'Check or create directory
  If Tmp(1) Then
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=DirName, _
  TextToDisplay:=DirName
  End If
  End With
  Next
  End With
  End Sub

  Function DirectoryExist(Directory As String, MessageYN As Boolean, CreateYN As Boolean)
  'Module testing/creating (sub-)directory
  'Directory : Name of the directory '
  'MessageYN: Error message will be displayed
  On Error GoTo MyError 'If there is a severe error

  'Declaration of variables
  Dim SubDirectory
  Dim MyIndex
  Dim Sep
  Dim Begin As Label, Make As Label, Einde As Label, MyErr As Label
  Dim Exist As Label, MyError As Label
  Dim Tmp 'Temporary result variabele
  ReDim Tmp(2) As Boolean
  
  ' Initial filling of variables
  Sep = "\"
  MyIndex = 3
  If 3 > Len(Directory) And Right(Directory, 1) = "\" Then GoTo MyErr 'back-slash not allowed at the end
  If "" <> Dir(Directory, vbDirectory) Then GoTo Exist
  
  Begin: 'For every (sub-)dir
  MyIndex = InStr(1 + MyIndex, Directory, Sep)
  If MyIndex = 0 Then
  SubDirectory = Directory
  Else
  SubDirectory = Mid(Directory, 1, MyIndex - 1)
  End If
  If MyIndex = 0 Or MyIndex = Len(Directory) Then GoTo Make
  If "" = Dir(SubDirectory, vbDirectory) Then GoTo Make
  If Len(SubDirectory) = Len(Directory) Then GoTo Einde
  GoTo Begin
  
  Make: 'For every (sub-)dir that doesn't exist
  If CreateYN Then
  MkDir SubDirectory
  If Len(SubDirectory) = Len(Directory) Then 'For the lowest sub
  If MessageYN Then MsgBox ("Directory aangemaakt: " & SubDirectory)
  End If
  If Len(SubDirectory) = Len(Directory) Then
  Tmp(1) = True
  Tmp(2) = True
  GoTo Einde
  Else
  GoTo Begin 'There is still another sub
  End If
  Else 'Don't create
  End If
  
  MyErr:
  Tmp(1) = False
  If MessageYN Then MsgBox "Directory-name not valid/not allowed: " & Directory
  GoTo Einde
  
  Exist:
  Tmp(1) = True
  'If MessageYN Then MsgBox "Directory already exists: " & Directory
  GoTo Einde
  
  MyError:
  Tmp(1) = False
  MsgBox Err.Description
  Einde:
  DirectoryExist = Tmp
  End Function
  

  
  
  

• PDACSKIVE

  Hey fiftyfive. Very good works great. just a couple of things

  The hyperlinks always start in cell A5. How do you change it is start in any cell

  Also if you want to. My numbering system works like

  Y:/2006/100 there are folders 100 to 199 in there

  Y:/2006/200 there are folders 200 to 299 in there

  and so on...................

  It would be good if it could handle this also. If you dont want to dont worry are change code each time, but it is a bit of a mission.

  It would be great if you could do this if it is not to much troble. Is going to save people a ot of time. cheers boots

  
  

• ihope

  thanks mate that is great. THis little intro has got me keen as to learn this stuff. How did you learn. Courses books or what. I have done a bit of c++.

  The mission. Doing this for work in my spare time. Each folder contains information for each job. The excel worksheet is a register to search for what you are looking for. How you can click on the job number and go stright to all the information for the job.

  Cool thanks agian you have been a great help

  
  

• Mp33

  Hi, thanks for the information, worked fine. However i dont think you have understood what i meant.

  I want the hyperlinks to link to folders not worksheets e.g. Y:\2006\100\.

  Can you do this cheers

  
  
• Hyper link Macro