Save As File Control

[tmort]

I'd like to be able to save a workbook as a single page non-interactiv
web page. I'd like the user to be able to select both the name for th
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 nam
and a path.

Thank

 

[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]

Thanks!

I don't see what how the optional works though

 

[Jake Marx]

Hi tmort,

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 i
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 i
a new workbook, then it deletes all other sheets. I use the last lin
to close the new one sheet workbook and go back to the orgina
workbook.

A simpler way is to just use:

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

Based on the thread I mentioned the I chose to use the longer method a
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.

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

 

[ajw150]

Hi,

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

wkb.SaveAs gsGetFilename

Any suggestions.

Andre

 

[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 Functio

 

[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 erro
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

Andre

 

[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 th
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 Functio

 

[tmort]

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

I made a new workbook with a sheet named ear and put a command butto
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 Functio

 

[tmort]

are you at the worksheet Ear when you do the saveas

 

[ajw150]

Hi,

Wow, it works. thanks for your help.

Andre