| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
opening a folder then creating links
I have this code that converts web addresses into links in this file that is created in another program. The problem is I have to copy the code form where it is and then paste it in the file's, with the links, VBE area. What I want is a message box to pop up so I can choose the file, with the links, and then it copies and pastes the code automaticly, then it runs the code. Code: -------------------- Sub MakeHyperlink() Range("B7").Select Dim strCellData As Variant Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Range("G7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Range("N7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Range("X7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Range("AG7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Range("AO7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next 'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop End Sub -------------------- -- tim64 ------------------------------------------------------------------------ tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
Backup your workbook before trying this macro. I condensed the code, range_copy is the range to be copied from, copy_to is the locatio where it will be copied Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n""x", "ag", "ao") range_copy = "b7:az30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name Range(range_copy).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\ & Selection.Value, TextToDisplay:=Selection.Value Loop Next End Su -- anilsolipura ----------------------------------------------------------------------- anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
there's an error (see below) Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n""x", "ag", "ao") range_copy = "b7:az30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename Workbooks.Open Filename:=file_name <----------- run time error '1004' n_file = ActiveWorkbook.Name Range(range_copy).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" Selection.Value, TextToDisplay:=Selection.Value Loop Next End Su -- tim6 ----------------------------------------------------------------------- tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
Try this macro, and type in the error that popsup Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "b7:az30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then On Error GoTo a: Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name Range(range_copy).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If a: MsgBox Err.Description End Su -- anilsolipura ----------------------------------------------------------------------- anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
the MsgBox said "select method of range class failed " Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "b7:az30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then On Error GoTo a: Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name Range(range_copy).Select <-------- it errors here Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If a: MsgBox Err.Description End Sub -- tim64 ------------------------------------------------------------------------ tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
now, what all msgs popsup Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "b7:az30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then On Error GoTo a: Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name msgbox range_copy Range(range_copy).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If a: MsgBox Err.Description End Sub -- anilsolipuram ------------------------------------------------------------------------ anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
the first one is "b7:az30" the second one is "select method of range class failed " -- tim64 ------------------------------------------------------------------------ tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
I changed the range_copy, let me know wha popsup Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "d10:d30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name msgbox range_copy Range(range_copy).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If End Sub -- anilsolipuram ------------------------------------------------------------------------ anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "d10:d30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name MsgBox range_copy <------- d10:d30 Range(range_copy).Select <----------- run time error '1004' Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If End Sub -- tim64 ------------------------------------------------------------------------ tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
It is working fine for me , i am not sure why it is not working for you. Try this and let me know what popups Sub MakeHyperlink() Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant v = Array("b", "G", "n", "x", "ag", "ao") range_copy = "a10:a30" copy_to = "b7" o_file = ActiveWorkbook.Name file_name = Application.GetOpenFilename If file_name < "" Then Workbooks.Open Filename:=file_name n_file = ActiveWorkbook.Name MsgBox range_copy msgbox Range(cstr(range_copy)).address Range(cstr(range_copy)).Select Selection.Copy Workbooks(o_file).Activate Range(copy_to).Select ActiveSheet.Paste Workbooks(n_file).Activate ActiveWorkbook.Save ActiveWorkbook.Close Workbooks(o_file).Activate For i = 0 To UBound(v) Range(v(i) & "7").Select Do Until ActiveCell.Value = "" strCellData = ActiveCell.Value ActiveCell.Value = strCellData ActiveCell.Offset(1, 0).Select On Error Resume Next ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value Loop Next End If End Sub -- anilsolipuram ------------------------------------------------------------------------ anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
first a10:a30 second $A$10:$A$30 third run time error '1004' -- tim64 ------------------------------------------------------------------------ tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
Trying opening different fil -- anilsolipura ----------------------------------------------------------------------- anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
does the same thin -- tim6 ----------------------------------------------------------------------- tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
I am guessing probably the file you are opening is worksheet protected or the some the are merged . I want you create the new file add save it in c:\, and then test the macro I sent you , now open the new_created file when file dialog comes up. -- anilsolipuram ------------------------------------------------------------------------ anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271 View this thread: http://www.excelforum.com/showthread...hreadid=383192 |
|
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
does the same thin -- tim6 ----------------------------------------------------------------------- tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
|
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
opening a folder then creating links
that wasn't the proble -- tim6 ----------------------------------------------------------------------- tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329 View this thread: http://www.excelforum.com/showthread.php?threadid=38319 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Slow opening links between workbooks with links created in 2003 | Excel Discussion (Misc queries) | |||
| Links to Local Drive Instead of Same Folder | Excel Discussion (Misc queries) | |||
| Creating a folder | Excel Discussion (Misc queries) | |||
| when opening folder | New Users to Excel | |||
| creating folder | Excel Programming | |||
![tim64[_31_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
