Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Create Hyperlink to URL
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Create Hyperlink to URL
Hey,

While inporting data from access into a excelsheet i want the URL-field to
became a hyperlinkfield so the user can click on it to go to the webpage
strange: when i doubleclick on the url it becomes a hyperlink !!!

Thanks,

Filip

Public Sub ExposantGegevensOphalenMetID(ByVal KlantID As Long, strMode As
String)

Dim MyConnection As String
Dim MySQL As String
Dim MyDatabaseFilePathAndName As String
Dim MyClient As Object
Dim iActiveRow As Long
Dim iLoop As Long
Dim strDataSource As String
Dim strEmail As String

'Create connection string
strDataSource = Sheets("datasource").Cells(1, 1).Value
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & strDataSource & ";"

' Create MySQL string
MySQL = "SELECT Deelnemers.* FROM Deelnemers WHERE
(((Deelnemers.DeelnemerID)=" & KlantID & "));"

' Open the database and copy the data
On Error GoTo SomeThingWrong
Set MyClient = CreateObject("adodb.recordset")
MyClient.Open MySQL, MyConnection, 0, 1, 1

If Not MyClient.EOF Then
Select Case strMode
Case "input"
iActiveRow = ActiveCell.Row
If Not IsNull(MyClient.fields(3)) Then
ActiveSheet.Cells(iActiveRow, 12) = MyClient.fields(3)
Case "detailsheet"
Sheets("Detail_Exposant").Activate
For iLoop = 0 To MyClient.fields.Count - 1
ActiveSheet.Cells(iLoop + 1, 1) =
MyClient.fields(iLoop).Name
If Not IsNull(MyClient.fields(iLoop)) Then
Select Case MyClient.fields(iLoop).Name
Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)
Case "URL"
ActiveSheet.Cells(iLoop + 1, 2) = "http://" &
MyClient.fields(iLoop) & "/"
Case Else
ActiveSheet.Cells(iLoop + 1, 2) =
MyClient.fields(iLoop)
End Select
End If
Next iLoop
Sheets("aankopen").Activate
End Select
Else
MsgBox "Exposant niet gevonden !" & vbCrLf & "Waarschijnlijk foutief
ID !", vbCritical
End If

MyClient.Close
Set MyClient = Nothing
Exit Sub

SomeThingWrong:
If MyClient.State = xlOpen Then
MyClient.Close
Set MyClient = Nothing
End If
If Err.Number = -2147467259 Then
MsgBox "Database '3_PRODUCTEURS DE VIN.mdb' niet gevonden !" &
Chr$(13) & "Dus geen gegevenoverdracht."
Else
MsgBox Err.Number & " " & Err.Description, vbCritical
End If
End Sub



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default Create Hyperlink to URL
Hi Filips

Add code to the macro to change the cell or cells to a hyperlink
If you tell me the range I post a example

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message ...
Hey,

While inporting data from access into a excelsheet i want the URL-field to
became a hyperlinkfield so the user can click on it to go to the webpage
strange: when i doubleclick on the url it becomes a hyperlink !!!

Thanks,

Filip

Public Sub ExposantGegevensOphalenMetID(ByVal KlantID As Long, strMode As
String)

Dim MyConnection As String
Dim MySQL As String
Dim MyDatabaseFilePathAndName As String
Dim MyClient As Object
Dim iActiveRow As Long
Dim iLoop As Long
Dim strDataSource As String
Dim strEmail As String

'Create connection string
strDataSource = Sheets("datasource").Cells(1, 1).Value
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & strDataSource & ";"

' Create MySQL string
MySQL = "SELECT Deelnemers.* FROM Deelnemers WHERE
(((Deelnemers.DeelnemerID)=" & KlantID & "));"

' Open the database and copy the data
On Error GoTo SomeThingWrong
Set MyClient = CreateObject("adodb.recordset")
MyClient.Open MySQL, MyConnection, 0, 1, 1

If Not MyClient.EOF Then
Select Case strMode
Case "input"
iActiveRow = ActiveCell.Row
If Not IsNull(MyClient.fields(3)) Then
ActiveSheet.Cells(iActiveRow, 12) = MyClient.fields(3)
Case "detailsheet"
Sheets("Detail_Exposant").Activate
For iLoop = 0 To MyClient.fields.Count - 1
ActiveSheet.Cells(iLoop + 1, 1) =
MyClient.fields(iLoop).Name
If Not IsNull(MyClient.fields(iLoop)) Then
Select Case MyClient.fields(iLoop).Name
Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)
Case "URL"
ActiveSheet.Cells(iLoop + 1, 2) = "http://" &
MyClient.fields(iLoop) & "/"
Case Else
ActiveSheet.Cells(iLoop + 1, 2) =
MyClient.fields(iLoop)
End Select
End If
Next iLoop
Sheets("aankopen").Activate
End Select
Else
MsgBox "Exposant niet gevonden !" & vbCrLf & "Waarschijnlijk foutief
ID !", vbCritical
End If

MyClient.Close
Set MyClient = Nothing
Exit Sub

SomeThingWrong:
If MyClient.State = xlOpen Then
MyClient.Close
Set MyClient = Nothing
End If
If Err.Number = -2147467259 Then
MsgBox "Database '3_PRODUCTEURS DE VIN.mdb' niet gevonden !" &
Chr$(13) & "Dus geen gegevenoverdracht."
Else
MsgBox Err.Number & " " & Err.Description, vbCritical
End If
End Sub



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Create Hyperlink to URL
Ron,

The range ( 1 cell ) is in the code = ActiveSheet.Cells(iLoop + 1, 2)

remark:
in the code below ( 1 mail) the code to create an hyperlink for email works
ok

Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)


F


"Ron de Bruin" wrote in message
...
Hi Filips
Add code to the macro to change the cell or cells to a hyperlink
If you tell me the range I post a example

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message
...
Hey,

While inporting data from access into a excelsheet i want the URL-field
to became a hyperlinkfield so the user can click on it to go to the
webpage
strange: when i doubleclick on the url it becomes a hyperlink !!!

Thanks,

Filip

Public Sub ExposantGegevensOphalenMetID(ByVal KlantID As Long, strMode As
String)

Dim MyConnection As String
Dim MySQL As String
Dim MyDatabaseFilePathAndName As String
Dim MyClient As Object
Dim iActiveRow As Long
Dim iLoop As Long
Dim strDataSource As String
Dim strEmail As String

'Create connection string
strDataSource = Sheets("datasource").Cells(1, 1).Value
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & strDataSource & ";"

' Create MySQL string
MySQL = "SELECT Deelnemers.* FROM Deelnemers WHERE
(((Deelnemers.DeelnemerID)=" & KlantID & "));"

' Open the database and copy the data
On Error GoTo SomeThingWrong
Set MyClient = CreateObject("adodb.recordset")
MyClient.Open MySQL, MyConnection, 0, 1, 1

If Not MyClient.EOF Then
Select Case strMode
Case "input"
iActiveRow = ActiveCell.Row
If Not IsNull(MyClient.fields(3)) Then
ActiveSheet.Cells(iActiveRow, 12) = MyClient.fields(3)
Case "detailsheet"
Sheets("Detail_Exposant").Activate
For iLoop = 0 To MyClient.fields.Count - 1
ActiveSheet.Cells(iLoop + 1, 1) =
MyClient.fields(iLoop).Name
If Not IsNull(MyClient.fields(iLoop)) Then
Select Case MyClient.fields(iLoop).Name
Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)
Case "URL"
ActiveSheet.Cells(iLoop + 1, 2) = "http://" &
MyClient.fields(iLoop) & "/"
Case Else
ActiveSheet.Cells(iLoop + 1, 2) =
MyClient.fields(iLoop)
End Select
End If
Next iLoop
Sheets("aankopen").Activate
End Select
Else
MsgBox "Exposant niet gevonden !" & vbCrLf & "Waarschijnlijk
foutief ID !", vbCritical
End If

MyClient.Close
Set MyClient = Nothing
Exit Sub

SomeThingWrong:
If MyClient.State = xlOpen Then
MyClient.Close
Set MyClient = Nothing
End If
If Err.Number = -2147467259 Then
MsgBox "Database '3_PRODUCTEURS DE VIN.mdb' niet gevonden !" &
Chr$(13) & "Dus geen gegevenoverdracht."
Else
MsgBox Err.Number & " " & Err.Description, vbCritical
End If
End Sub



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default Create Hyperlink to URL
For a website you can use this instead of mailto

"http://:" &


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message ...
Ron,

The range ( 1 cell ) is in the code = ActiveSheet.Cells(iLoop + 1, 2)

remark:
in the code below ( 1 mail) the code to create an hyperlink for email works
ok

Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)


F


"Ron de Bruin" wrote in message
...
Hi Filips
Add code to the macro to change the cell or cells to a hyperlink
If you tell me the range I post a example

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message
...
Hey,

While inporting data from access into a excelsheet i want the URL-field
to became a hyperlinkfield so the user can click on it to go to the
webpage
strange: when i doubleclick on the url it becomes a hyperlink !!!

Thanks,

Filip

Public Sub ExposantGegevensOphalenMetID(ByVal KlantID As Long, strMode As
String)

Dim MyConnection As String
Dim MySQL As String
Dim MyDatabaseFilePathAndName As String
Dim MyClient As Object
Dim iActiveRow As Long
Dim iLoop As Long
Dim strDataSource As String
Dim strEmail As String

'Create connection string
strDataSource = Sheets("datasource").Cells(1, 1).Value
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & strDataSource & ";"

' Create MySQL string
MySQL = "SELECT Deelnemers.* FROM Deelnemers WHERE
(((Deelnemers.DeelnemerID)=" & KlantID & "));"

' Open the database and copy the data
On Error GoTo SomeThingWrong
Set MyClient = CreateObject("adodb.recordset")
MyClient.Open MySQL, MyConnection, 0, 1, 1

If Not MyClient.EOF Then
Select Case strMode
Case "input"
iActiveRow = ActiveCell.Row
If Not IsNull(MyClient.fields(3)) Then
ActiveSheet.Cells(iActiveRow, 12) = MyClient.fields(3)
Case "detailsheet"
Sheets("Detail_Exposant").Activate
For iLoop = 0 To MyClient.fields.Count - 1
ActiveSheet.Cells(iLoop + 1, 1) =
MyClient.fields(iLoop).Name
If Not IsNull(MyClient.fields(iLoop)) Then
Select Case MyClient.fields(iLoop).Name
Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection,
Address:= _
"mailto:" & MyClient.fields(iLoop)
Case "URL"
ActiveSheet.Cells(iLoop + 1, 2) = "http://" &
MyClient.fields(iLoop) & "/"
Case Else
ActiveSheet.Cells(iLoop + 1, 2) =
MyClient.fields(iLoop)
End Select
End If
Next iLoop
Sheets("aankopen").Activate
End Select
Else
MsgBox "Exposant niet gevonden !" & vbCrLf & "Waarschijnlijk
foutief ID !", vbCritical
End If

MyClient.Close
Set MyClient = Nothing
Exit Sub

SomeThingWrong:
If MyClient.State = xlOpen Then
MyClient.Close
Set MyClient = Nothing
End If
If Err.Number = -2147467259 Then
MsgBox "Database '3_PRODUCTEURS DE VIN.mdb' niet gevonden !" &
Chr$(13) & "Dus geen gegevenoverdracht."
Else
MsgBox Err.Number & " " & Err.Description, vbCritical
End If
End Sub



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Create Hyperlink to URL
The cell only becomes a hyperlink ( bleu and handcursor) after doubleclick
on the cell and reselecting the cell.
It's not a hyperlink directly like in the case of the emailcell above it.

F


"Ron de Bruin" wrote in message
...
For a website you can use this instead of mailto

"http://:" &


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message
...
Ron,

The range ( 1 cell ) is in the code = ActiveSheet.Cells(iLoop + 1, 2)

remark:
in the code below ( 1 mail) the code to create an hyperlink for email
works ok

Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add
Anchor:=Selection, Address:= _
"mailto:" & MyClient.fields(iLoop)


F


"Ron de Bruin" wrote in message
...
Hi Filips
Add code to the macro to change the cell or cells to a hyperlink
If you tell me the range I post a example

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Filips Benoit" wrote in message
...
Hey,

While inporting data from access into a excelsheet i want the URL-field
to became a hyperlinkfield so the user can click on it to go to the
webpage
strange: when i doubleclick on the url it becomes a hyperlink !!!

Thanks,

Filip

Public Sub ExposantGegevensOphalenMetID(ByVal KlantID As Long, strMode
As String)

Dim MyConnection As String
Dim MySQL As String
Dim MyDatabaseFilePathAndName As String
Dim MyClient As Object
Dim iActiveRow As Long
Dim iLoop As Long
Dim strDataSource As String
Dim strEmail As String

'Create connection string
strDataSource = Sheets("datasource").Cells(1, 1).Value
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & strDataSource & ";"

' Create MySQL string
MySQL = "SELECT Deelnemers.* FROM Deelnemers WHERE
(((Deelnemers.DeelnemerID)=" & KlantID & "));"

' Open the database and copy the data
On Error GoTo SomeThingWrong
Set MyClient = CreateObject("adodb.recordset")
MyClient.Open MySQL, MyConnection, 0, 1, 1

If Not MyClient.EOF Then
Select Case strMode
Case "input"
iActiveRow = ActiveCell.Row
If Not IsNull(MyClient.fields(3)) Then
ActiveSheet.Cells(iActiveRow, 12) = MyClient.fields(3)
Case "detailsheet"
Sheets("Detail_Exposant").Activate
For iLoop = 0 To MyClient.fields.Count - 1
ActiveSheet.Cells(iLoop + 1, 1) =
MyClient.fields(iLoop).Name
If Not IsNull(MyClient.fields(iLoop)) Then
Select Case MyClient.fields(iLoop).Name
Case "Email"
ActiveSheet.Cells(iLoop + 1, 2).Select
ActiveSheet.Hyperlinks.Add
Anchor:=Selection, Address:= _
"mailto:" & MyClient.fields(iLoop)
Case "URL"
ActiveSheet.Cells(iLoop + 1, 2) = "http://"
& MyClient.fields(iLoop) & "/"
Case Else
ActiveSheet.Cells(iLoop + 1, 2) =
MyClient.fields(iLoop)
End Select
End If
Next iLoop
Sheets("aankopen").Activate
End Select
Else
MsgBox "Exposant niet gevonden !" & vbCrLf & "Waarschijnlijk
foutief ID !", vbCritical
End If

MyClient.Close
Set MyClient = Nothing
Exit Sub

SomeThingWrong:
If MyClient.State = xlOpen Then
MyClient.Close
Set MyClient = Nothing
End If
If Err.Number = -2147467259 Then
MsgBox "Database '3_PRODUCTEURS DE VIN.mdb' niet gevonden !" &
Chr$(13) & "Dus geen gegevenoverdracht."
Else
MsgBox Err.Number & " " & Err.Description, vbCritical
End If
End Sub





Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Need to create an automatic hyperlink [email protected] Excel Discussion (Misc queries) 3 April 1st 10 03:39 PM
Create hyperlink without filename? [email protected] Excel Worksheet Functions 4 April 20th 07 01:30 AM
create tabs and add hyperlink to each tab May Excel Programming 1 March 13th 07 11:57 PM
How do I create a hyperlink to a cell with the hyperlink function S. Bevins Excel Worksheet Functions 2 July 20th 06 08:06 PM
Create Hyperlink maperalia Excel Programming 2 April 10th 06 01:15 AM


All times are GMT +1. The time now is 02:06 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement