code to save a workbook and add a hyperlink to another works

[jamienwood]

I want a macro to save a workSHEET(eg sheet1) as a seperate workBOOK and have it give the book a name from cell A1 i also want it to add a macro to the worksheet(eg sheet2) of the open workbook, and if atall possible next to the cell that has the same value as that was in cell A1 (also what the file is now called)

 

[Legacy 98055]

Hi jamienwood.
That is easily doable. Just a question?
What is the path to save the new workbook or do you want a save as dialog to popup so the user can specify a path?
Tom

 

[brettvba]

you want something like this
Sub Macro1()

'
Dim bookname
bookname = InputBox("Enter New Book Name")

Sheets("sheet1").Select
Sheets("sheet1").Copy
ActiveWorkbook.SaveAs Filename:="C:" & (Book1) & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Windows("original book.xls").Activate
Range("a2").Select
bookname = ActiveCell.Value
End Sub
This message was edited by brettvba on 2002-04-15 13:52

 

[jamienwood]

On 2002-04-15 13:48, TsTom wrote:
Hi jamienwood.
That is easily doable. Just a question?
What is the path to save the new workbook or do you want a save as dialog to popup so the user can specify a path?
Tom

I sorta have most of the code its a bit messy but here it is its mainly the hyperlink that i need, here goesRange("B6:I26").Select
Selection.Copy
Workbooks.Add
Range("B6").Select
ActiveSheet.Paste
Columns("B:B").ColumnWidth = 8.57
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 8.29
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 31.43
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 12.43
Rows("20:20").RowHeight = 15
Rows("20:20").RowHeight = 15.75
Rows("24:24").RowHeight = 19.5
Range("C2:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "Customer Quote"
Range("C3").Select
ActiveWindow.DisplayGridlines = False
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Quote"
Range("B6:I26").Select
Selection.Interior.ColorIndex = xlNone
Range("G26:I26").Select
Selection.Font.ColorIndex = 2
ThisFile2002 = Range("B7").Value
ActiveWorkbook.SaveAs Filename:=ThisFile2002
ActiveWorkbook.Close
Application.Run "Quote_Print"

What it is i have designed a qoute system and the qoute is on one worksheet and on the next is a customer database the quote is currently saved as the customers reference no. i then want a hyperlink on the customer database to open the just saved file.
I also would like a current data to be added(of when the quote was made) and then a daily updated one so you can see the quote will expire in 30 days 29, 28 so on.

 

[brettvba]

try this for the hyper link
Sub Macro1()

'
Dim bookname
bookname = InputBox("Enter New Book Name")
bookname
Sheets("sheet1").Select
Sheets("sheet1").Copy
ActiveWorkbook.SaveAs Filename:="C:" & (Book1) & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Windows("original book.xls").Activate
Range("a2").Select
' Hyper Link
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:" & (bookname) & ".xls", _
TextToDisplay:=(bookname)
End Sub

Only one backslash tho some how this forum displays 2
This message was edited by brettvba on 2002-04-15 14:14