PDA

View Full Version : Solved: save sheet to desktop with name from cell



danovkos
05-20-2009, 11:59 PM
Hi all, how can i put together this 2 codes?
And how can i give a name to saved file based on content of cell C9?

I tried it, but it doesnt works.

I need save only active sheet to desktop (there is not specified concrete path, i want to use it to many computers) with name from content of cell C9 and actual date.

thx.



Sub SaveTOdesktop()
Rem With ActiveWorkbook
With ActiveWorkbook
.saveas CreateObject("WScript.Shell").SpecialFolders("DeskTop") & Application.PathSeparator & .Name
End With

End Sub
Sub SaveAndDate()
Worksheets("navrh").Copy
ActiveWorkbook.saveas Filename:= _
ThisWorkbook.Path & "/" & ActiveSheet.Name & " " & Format(Date, "dd mmm yyyy"), FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False
End Sub

GTO
05-21-2009, 01:10 AM
Greetings Danovkos,

I believe this should work okay.


Option Explicit
Sub SaveActiveSheet()
Dim wb As Workbook
Dim wksActive As Worksheet
Dim strUserDesktop As String
Dim strNewName As String

'// Set a reference to the ActiveSheet, then create the new filename. //
Set wksActive = ThisWorkbook.ActiveSheet
strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"

'// Set a reference to a new one sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)

'// Get the current user's path to Desktop //
strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator

'// With the new wb, copy our previously active sheet to it, delete the //
'// one blank sheet that the new wb was created with, then SaveAs. //
With wb
wksActive.Copy .Sheets(1)
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
.SaveAs strUserDesktop & strNewName
End With
End Sub


Hope that helps,

Mark

danovkos
05-21-2009, 02:34 AM
yes, this works perfect, great code :)
thx a lot

danovkos
05-21-2009, 03:49 AM
sorry, a little detail yet, maybe offtopic.
how can i define object. Because i want to change all of data in new saved file only to value

i tried this, but it doesnt works :(
still problem with define object
thx


Sub SaveTODesktop()
Dim wb As Workbook
Dim wksActive As Worksheet
Dim strUserDesktop As String
Dim strNewName As String

'// Set a reference to the ActiveSheet, then create the new filename. //
Set wksActive = ThisWorkbook.ActiveSheet
strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"

'// Set a reference to a new one sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)

'// Get the current user's path to Desktop //
strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator

'// With the new wb, copy our previously active sheet to it, delete the //
'// one blank sheet that the new wb was created with, then SaveAs. //
With wb
wksActive.Copy .Sheets(1)
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
.SaveAs strUserDesktop & strNewName

Windows(strNewName).Activate
Sheets("navrh").Select
Range("A1:J1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A1:J96").Select
Selection.Copy
Application.CutCopyMode = False
Range("A1").Select
End With
End Sub

GTO
05-21-2009, 04:31 AM
Greetings again,

That is not a problem w/the object; you switched to addressing the Window, which is another object alltogether.

Glad you checked back, as I happen to think about something on the way home. Presuming you are having other users use the wb, we might want to block them from the chance ("chance" meaning it will happen for sure when you are busy or off on vacation...) bad entry for a filename.

This will prevent the user from entering illegal characters in C9 for the new filename. Not so sure on whether it will correctly sub vals for formulas, but here's a stab, as I have to hit the rack...


Option Explicit

Sub SaveActiveSheet()
Dim wb As Workbook
Dim wksActive As Worksheet
Dim strUserDesktop As String
Dim strNewName As String

If IllegalName(ActiveSheet.Range("C9")) Then
MsgBox "You cannot use any of the following characters as part" & vbCrLf & _
"of the filename:" & String(2, vbCrLf) & _
vbTab & "< > ? [ ] : | *" & String(2, vbCrLf) & _
"Please re-enter a filename in C9.", vbCritical, vbNullString

ActiveSheet.Range("C9").ClearContents
Exit Sub
End If

'// Set a reference to the ActiveSheet, then create the new filename. //
Set wksActive = ThisWorkbook.ActiveSheet
strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"

'// Set a reference to a new one sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)

'// Get the current user's path to Desktop //
strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator

'// With the new wb, copy our previously active sheet to it, delete the //
'// one blank sheet that the new wb was created with, then SaveAs. //
With wb
wksActive.Copy .Sheets(1)
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
'***Change here.***
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value

.SaveAs strUserDesktop & strNewName
End With
End Sub

Function IllegalName(FName As String) As Boolean
Dim a()
Dim i As Long

a = Array("<", ">", "?", "[", "]", ":", "|", "*")
For i = LBound(a()) To UBound(a())
If Not InStr(1, FName, a(i), vbTextCompare) = 0 Then
IllegalName = True
Exit For
End If
Next
End Function


Hope this helps,

Mark

danovkos
05-21-2009, 04:38 AM
thank you very much...this works great