Save As File Control

[tmort]

I'd like to be able to save a workbook as a single page non-interactive web page. I'd like the user to be able to select both the name for the file and the save path.

So far all I can come up with is:

Sub Savesheet()
With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
"C:\Documents and Settings\My Documents\Book1.mht", "Sheet2", "", _
xlHtmlStatic, InputBox("enter file name"), "")
.Publish (True)
.AutoRepublish = False
End With
End Sub

The user can select a file name only.

I'd like to call a file control so the user can select both a file name and a path.

Thanks

[Jake Marx]

Hi tmort,

You can use the GetSaveAsFilename method to do this:

Public Function gsGetFilename(Optional rsInitialPathFName _
As String = vbNullString) As String
Dim vPath As Variant

vPath = Application.GetSaveAsFilename(rsInitialPathFName, _
"Microsoft Excel Files (*.xls), *.xls")

If vPath <> False Then gsGetFilename = CStr(vPath)
End Function

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]


tmort wrote:
> I'd like to be able to save a workbook as a single page
> non-interactive web page. I'd like the user to be able to select
> both the name for the file and the save path.
>
> So far all I can come up with is:
>
> Sub Savesheet()
> With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
> "C:\Documents and Settings\My Documents\Book1.mht", "Sheet2",
> "", _
> xlHtmlStatic, InputBox("enter file name"), "")
> Publish (True)
> AutoRepublish = False
> End With
> End Sub
>
> The user can select a file name only.
>
> I'd like to call a file control so the user can select both a file
> name and a path.
>
> Thanks

[tmort]

Thanks!

I don't see what how the optional works though.

[Jake Marx]

Hi tmort,

tmort wrote:
> I don't see what how the optional works though.

The optional parameter was something I added to my function to enable an
intial filename and/or file path. If, for example, you wanted the default
filename to be "testing.xls", you could do this:

Debug.Print gsGetFilename("testing.xls")

If you wanted the file path to default to the C: drive, you could do this:

Debug.Print gsGetFilename("C:\")

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

[ajw150]

Hi,

That scripting looks good and is just what I was after. How would I make it save a particular worksheet, but still popup the save as screen.

Thanks

Andrew

[tmort]

I found anothe thread in this forum on saving a single sheet. Below is the code that I am using along with the getfilename function:

Private Sub CommandButton16_Click()


Set wkb = Workbooks.Add
ThisWorkbook.Sheets("sheetname").Copy Before:=wkb.Sheets(1)
Application.DisplayAlerts = False
For i = wkb.Sheets.Count To 2 Step -1
' Delete all but the 1st sheet
wkb.Sheets(i).Delete
Next i
Application.DisplayAlerts = True

wkb.SaveAs gsGetFilename

wkb.Close



End Sub

The first part makes a copy of the sheet named sheetname and puts it in a new workbook, then it deletes all other sheets. I use the last line to close the new one sheet workbook and go back to the orginal workbook.

A simpler way is to just use:

Worksheets("Sheet1").Copy which copies the sheet to a new single sheet workbook which will then be the active sheet.

Based on the thread I mentioned the I chose to use the longer method as according to one poster the second method is an undocumented method.

[Norman Jones]

Hi Tmort,

> Based on the thread I mentioned the I chose to use the longer method as
> according to one poster the second method is an undocumented method.

From VBA help on the Copy Method:

'=====================================
If you don't specify either Before or After, Microsoft Excel creates a new
workbook that contains the copied sheet.

'=====================================

---
Regards,
Norman



"tmort" <[email protected]> wrote in
message news:[email protected]...
>
> I found anothe thread in this forum on saving a single sheet. Below is
> the code that I am using along with the getfilename function:
>
> Private Sub CommandButton16_Click()
>
>
> Set wkb = Workbooks.Add
> ThisWorkbook.Sheets("sheetname").Copy Before:=wkb.Sheets(1)
> Application.DisplayAlerts = False
> For i = wkb.Sheets.Count To 2 Step -1
> ' Delete all but the 1st sheet
> wkb.Sheets(i).Delete
> Next i
> Application.DisplayAlerts = True
>
> wkb.SaveAs gsGetFilename
>
> wkb.Close
>
>
>
> End Sub
>
> The first part makes a copy of the sheet named sheetname and puts it in
> a new workbook, then it deletes all other sheets. I use the last line
> to close the new one sheet workbook and go back to the orginal
> workbook.
>
> A simpler way is to just use:
>
> Worksheets("Sheet1").Copy which copies the sheet to a new single sheet
> workbook which will then be the active sheet.
>
> Based on the thread I mentioned the I chose to use the longer method as
> according to one poster the second method is an undocumented method.
>
>
> --
> tmort
> ------------------------------------------------------------------------
> tmort's Profile:
> http://www.excelforum.com/member.php...o&userid=21053
> View this thread: http://www.excelforum.com/showthread...hreadid=389077
>

[ajw150]

Hi,

Thanks for that. The correct sheet moves into a new book but then I get an error with :

wkb.SaveAs gsGetFilename

Any suggestions.

Andrew

[tmort]

have you created the new function gsgetfilecontrol()?

If not just copy it to the very end of the code

Public Function gsGetFilename(Optional rsInitialPathFName _
As String = vbNullString) As String
Dim vPath As Variant

vPath = Application.GetSaveAsFilename(rsInitialPathFName, _
"Microsoft Excel Files (*.xls), *.xls")

If vPath <> False Then gsGetFilename = CStr(vPath)
End Function

[ajw150]

Hi again,

Thanks for your help. I think we are getting close!
The Save As screen now comes up but I still get a debug - RunTime error 1004 surrounding wkb.SaveAs gsGetFilename. !

Sub SaveMe1()
Set wkb = Workbooks.Add
ThisWorkbook.Sheets("EAR").Copy Before:=wkb.Sheets(1)
Application.DisplayAlerts = False
For i = wkb.Sheets.Count To 2 Step -1
' Delete all but the 1st sheet
wkb.Sheets(i).Delete
Next i
Application.DisplayAlerts = True

wkb.SaveAs gsGetFilename
wkb.Close
End Sub
Public Function gsGetFilename(Optional rsInitialPathFName _
As String = vbNullString) As String
Dim vPath As Variant

vPath = Application.GetSaveAsFilename(rsInitialPathFName, _
"Microsoft Excel Files (*.xls), *.xls")

If vPath <> False Then gsGetFilename = CStr(vPath)
End Function


Any ideas?

Thanks

Andrew

[tmort]

Change this line:

Public Function gsGetFilename(Optional rsInitialPathFName _
As String = vbNullString) As String

to this:

Public Function gsGetFilename() As String

I think that is the cause of the error

[ajw150]

Hi,

Thanks for the reply again. But I still get a 1004 error to do with the wkb.SaveAs gsGetFilename.

Sub SaveMe1()
Set wkb = Workbooks.Add
ThisWorkbook.Sheets("EAR").Copy Before:=wkb.Sheets(1)
Application.DisplayAlerts = False
For i = wkb.Sheets.Count To 2 Step -1
' Delete all but the 1st sheet
wkb.Sheets(i).Delete
Next i
Application.DisplayAlerts = True

wkb.SaveAs gsGetFilename
wkb.Close
End Sub
Public Function gsGetFilename() As String

vPath = Application.GetSaveAsFilename(rsInitialPathFName, _
"Microsoft Excel Files (*.xls), *.xls")

If vPath <> False Then gsGetFilename = CStr(vPath)
End Function

[tmort]

I'm don't know what the problem is.

I made a new workbook with a sheet named ear and put a command button on it and copied your code and it worked OK:

Private Sub CommandButton1_Click()

Call SaveMe1

End Sub


Sub SaveMe1()
Set wkb = Workbooks.Add
ThisWorkbook.Sheets("EAR").Copy Before:=wkb.Sheets(1)
Application.DisplayAlerts = False
For i = wkb.Sheets.Count To 2 Step -1
' Delete all but the 1st sheet
wkb.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
wkb.SaveAs gsGetFilename
wkb.Close
End Sub


Public Function gsGetFilename() As String

vPath = Application.GetSaveAsFilename(rsInitialPathFName, _
"Microsoft Excel Files (*.xls), *.xls")

If vPath <> False Then gsGetFilename = CStr(vPath)
End Function

[tmort]

are you at the worksheet Ear when you do the saveas?

[ajw150]

Hi,

Wow, it works. thanks for your help.

Andrew