Here it is a simple question (I suspect the answer isn't..)
This code keeps the document in a Dir A: as Text I need that also keeps a
copy in Desktop
Thank's in Advance
Aqui es donde empiezo a imprimir el Cheque

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name = "Cheque" Then
If InputBox("Escriba su Clave") < "enero2012" Then
MsgBox "Consiga una clave!!"
Range("A8").Select
Cancel = True
End If
End If
End Sub






Sub ImprimirCheque()
Dim FileSaveName As String
Dim TextExportExcel As Object
Set TextExportExcel = ThisWorkbook
Dim c As Object
Dim MyRange As Object

If Worksheets("Cheque").Range("R9") = "" Then
Range("R9").Select
MsgBox "Escriba la cantidad del cheque.", vbInformation, "MuEbLeS De
MeXiCo"
Exit Sub
End If
If Worksheets("Cheque").Range("P15") = "" Then
Range("P15").Select
MsgBox "Seleccione un concepto de pago.", vbInformation, "MuEbLeS De
MeXiCo"
Exit Sub
End If
Application.ScreenUpdating = False
Answer = MsgBox _
(" Esta el nombre o compañia y el numero de cheque correctos ? " &
Chr(13) & Chr(13) & _
"Si no lo es haga click en no y corrija la informacion ", vbYesNo,
"Maderas Y Muebles de Mexico")
If Answer = vbNo Then Exit Sub ' the macro ends if the user selects the
CANCEL-button
Application.GoTo Reference:="ImprimirCheque"
Selection.PrintOut Copies:=1, Collate:=True
Range("A1").Select
Sheets("PolizaToDisk").Select
ActiveSheet.Unprotect Password:="nelvita"
GetFile:

Set MyRange = ActiveCell.CurrentRegion.Rows
mypath = "a:\" 'set path to folder here, or use
'mypath=Application.DefaultFilePath
Range("B1").Select
'MsgBox "Text File Name := " & ActiveSheet.Name
FileSaveName = Application.GetSaveAsFilename _
(InitialFileName:=CStr(mypath & ActiveCell.Value), _
filefilter:="Text Files (*.txt), *.txt")
If Dir(FileSaveName) < "" Then
Select Case MsgBox("File already exists! Overwrite?", vbYesNoCancel +
vbExclamation)
Case vbNo
GoTo GetFile
Case vbCancel
Sheets("Cheque").Select
Exit Sub
End Select
End If
'MsgBox " FileSaveName :" & FileSaveName
ActiveSheet.Protect Password:="nelvita"

WriteFile MyRange, FileSaveName
Sheets("Cheque").Select
ORDER# = Range("ChequeNo").Value
Range("ChequeNo") = ORDER# + 1
Sheets("Cheque").Select
Range("R6").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=NOW()"
Range("R9").Select
Selection.ClearContents
Range("P15").Select
Selection.ClearContents
Range("R9").Select
Application.ScreenUpdating = True
Application.StatusBar = "Espere!... Guardandoprogama y numero de cheque"
MsgBox "Se ha guardado una copia en el archivo Mis Documentos," _
& Chr(13) & Chr(13) & _
"Folder PlizaToCheck Como Procedimiento de BackUp.", _
vbInformation, "MuEbLeS De MeXiCo"
ActiveWorkbook.Save
Application.StatusBar = False
Exit Sub
Application.ScreenUpdating = True
End Sub
Sub WriteFile(MyRange, FileSaveName)
Dim FF As Integer, MyLine As String
FF = 0
FileNum = FreeFile ' next file number
' open the file & add currently selected data to the file (or create it)
Open FileSaveName For Append As #FileNum
'use output instead of append if you want to overwrite
'the entire file each time
For Each c In MyRange 'c=rows in range
'assuming five columns of data to be written to file
Print #FileNum, Cells(c.Row, c.Column).Text, _
Cells(c.Row, c.Column + 1).Text, Cells(c.Row, c.Column + 2) _
.Text, Cells(c.Row, c.Column + 3).Text, _
Cells(c.Row, c.Column + 4).Text
Next
Close #FileNum ' close the file
'MsgBox MyLine, vbInformation, "Last log information:"
End Sub

This shows how to find the path to the desktop folder:

Sub ShowDeskTopFolder()
MsgBox CreateObject("WScript.Shell").SpecialFolders.Item( "Desktop")
End Sub


--
Jim
"Antonyo" wrote in message
...
| Here it is a simple question (I suspect the answer isn't..)
| This code keeps the document in a Dir A: as Text I need that also keeps a
| copy in Desktop
| Thank's in Advance
| Aqui es donde empiezo a imprimir el Cheque
|
| Private Sub Workbook_BeforePrint(Cancel As Boolean)
| If ActiveSheet.Name = "Cheque" Then
| If InputBox("Escriba su Clave") < "enero2012" Then
| MsgBox "Consiga una clave!!"
| Range("A8").Select
| Cancel = True
| End If
| End If
| End Sub
|
|
|
|
|
|
| Sub ImprimirCheque()
| Dim FileSaveName As String
| Dim TextExportExcel As Object
| Set TextExportExcel = ThisWorkbook
| Dim c As Object
| Dim MyRange As Object
|
| If Worksheets("Cheque").Range("R9") = "" Then
| Range("R9").Select
| MsgBox "Escriba la cantidad del cheque.", vbInformation, "MuEbLeS De
| MeXiCo"
| Exit Sub
| End If
| If Worksheets("Cheque").Range("P15") = "" Then
| Range("P15").Select
| MsgBox "Seleccione un concepto de pago.", vbInformation, "MuEbLeS De
| MeXiCo"
| Exit Sub
| End If
| Application.ScreenUpdating = False
| Answer = MsgBox _
| (" Esta el nombre o compañia y el numero de cheque correctos ? " &
| Chr(13) & Chr(13) & _
| "Si no lo es haga click en no y corrija la informacion ", vbYesNo,
| "Maderas Y Muebles de Mexico")
| If Answer = vbNo Then Exit Sub ' the macro ends if the user selects the
| CANCEL-button
| Application.GoTo Reference:="ImprimirCheque"
| Selection.PrintOut Copies:=1, Collate:=True
| Range("A1").Select
| Sheets("PolizaToDisk").Select
| ActiveSheet.Unprotect Password:="nelvita"
| GetFile:
|
| Set MyRange = ActiveCell.CurrentRegion.Rows
| mypath = "a:\" 'set path to folder here, or use
| 'mypath=Application.DefaultFilePath
| Range("B1").Select
| 'MsgBox "Text File Name := " & ActiveSheet.Name
| FileSaveName = Application.GetSaveAsFilename _
| (InitialFileName:=CStr(mypath & ActiveCell.Value), _
| filefilter:="Text Files (*.txt), *.txt")
| If Dir(FileSaveName) < "" Then
| Select Case MsgBox("File already exists! Overwrite?", vbYesNoCancel +
| vbExclamation)
| Case vbNo
| GoTo GetFile
| Case vbCancel
| Sheets("Cheque").Select
| Exit Sub
| End Select
| End If
| 'MsgBox " FileSaveName :" & FileSaveName
| ActiveSheet.Protect Password:="nelvita"
|
| WriteFile MyRange, FileSaveName
| Sheets("Cheque").Select
| ORDER# = Range("ChequeNo").Value
| Range("ChequeNo") = ORDER# + 1
| Sheets("Cheque").Select
| Range("R6").Select
| Selection.ClearContents
| ActiveCell.FormulaR1C1 = "=NOW()"
| Range("R9").Select
| Selection.ClearContents
| Range("P15").Select
| Selection.ClearContents
| Range("R9").Select
| Application.ScreenUpdating = True
| Application.StatusBar = "Espere!... Guardandoprogama y numero de cheque"
| MsgBox "Se ha guardado una copia en el archivo Mis Documentos," _
| & Chr(13) & Chr(13) & _
| "Folder PlizaToCheck Como Procedimiento de BackUp.", _
| vbInformation, "MuEbLeS De MeXiCo"
| ActiveWorkbook.Save
| Application.StatusBar = False
| Exit Sub
| Application.ScreenUpdating = True
| End Sub
| Sub WriteFile(MyRange, FileSaveName)
| Dim FF As Integer, MyLine As String
| FF = 0
| FileNum = FreeFile ' next file number
| ' open the file & add currently selected data to the file (or create it)
| Open FileSaveName For Append As #FileNum
| 'use output instead of append if you want to overwrite
| 'the entire file each time
| For Each c In MyRange 'c=rows in range
| 'assuming five columns of data to be written to file
| Print #FileNum, Cells(c.Row, c.Column).Text, _
| Cells(c.Row, c.Column + 1).Text, Cells(c.Row, c.Column + 2) _
| .Text, Cells(c.Row, c.Column + 3).Text, _
| Cells(c.Row, c.Column + 4).Text
| Next
| Close #FileNum ' close the file
| 'MsgBox MyLine, vbInformation, "Last log information:"
| End Sub
|
|
|

Without addressing your question...

It's very bad to work directly against a floppy disk. Lots can go wrong.

I think you'd be much better off keeping one copy on your local harddrive (or
LAN) and then use windows explorer to copy a backup to the floppy (if you need a
backup). Or use windows explorer to copy the file to another location.

Antonyo wrote:

Here it is a simple question (I suspect the answer isn't..)
This code keeps the document in a Dir A: as Text I need that also keeps a
copy in Desktop
Thank's in Advance
Aqui es donde empiezo a imprimir el Cheque

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name = "Cheque" Then
If InputBox("Escriba su Clave") < "enero2012" Then
MsgBox "Consiga una clave!!"
Range("A8").Select
Cancel = True
End If
End If
End Sub

Sub ImprimirCheque()
Dim FileSaveName As String
Dim TextExportExcel As Object
Set TextExportExcel = ThisWorkbook
Dim c As Object
Dim MyRange As Object

If Worksheets("Cheque").Range("R9") = "" Then
Range("R9").Select
MsgBox "Escriba la cantidad del cheque.", vbInformation, "MuEbLeS De
MeXiCo"
Exit Sub
End If
If Worksheets("Cheque").Range("P15") = "" Then
Range("P15").Select
MsgBox "Seleccione un concepto de pago.", vbInformation, "MuEbLeS De
MeXiCo"
Exit Sub
End If
Application.ScreenUpdating = False
Answer = MsgBox _
(" Esta el nombre o compañia y el numero de cheque correctos ? " &
Chr(13) & Chr(13) & _
"Si no lo es haga click en no y corrija la informacion ", vbYesNo,
"Maderas Y Muebles de Mexico")
If Answer = vbNo Then Exit Sub ' the macro ends if the user selects the
CANCEL-button
Application.GoTo Reference:="ImprimirCheque"
Selection.PrintOut Copies:=1, Collate:=True
Range("A1").Select
Sheets("PolizaToDisk").Select
ActiveSheet.Unprotect Password:="nelvita"
GetFile:

Set MyRange = ActiveCell.CurrentRegion.Rows
mypath = "a:\" 'set path to folder here, or use
'mypath=Application.DefaultFilePath
Range("B1").Select
'MsgBox "Text File Name := " & ActiveSheet.Name
FileSaveName = Application.GetSaveAsFilename _
(InitialFileName:=CStr(mypath & ActiveCell.Value), _
filefilter:="Text Files (*.txt), *.txt")
If Dir(FileSaveName) < "" Then
Select Case MsgBox("File already exists! Overwrite?", vbYesNoCancel +
vbExclamation)
Case vbNo
GoTo GetFile
Case vbCancel
Sheets("Cheque").Select
Exit Sub
End Select
End If
'MsgBox " FileSaveName :" & FileSaveName
ActiveSheet.Protect Password:="nelvita"

WriteFile MyRange, FileSaveName
Sheets("Cheque").Select
ORDER# = Range("ChequeNo").Value
Range("ChequeNo") = ORDER# + 1
Sheets("Cheque").Select
Range("R6").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=NOW()"
Range("R9").Select
Selection.ClearContents
Range("P15").Select
Selection.ClearContents
Range("R9").Select
Application.ScreenUpdating = True
Application.StatusBar = "Espere!... Guardandoprogama y numero de cheque"
MsgBox "Se ha guardado una copia en el archivo Mis Documentos," _
& Chr(13) & Chr(13) & _
"Folder PlizaToCheck Como Procedimiento de BackUp.", _
vbInformation, "MuEbLeS De MeXiCo"
ActiveWorkbook.Save
Application.StatusBar = False
Exit Sub
Application.ScreenUpdating = True
End Sub
Sub WriteFile(MyRange, FileSaveName)
Dim FF As Integer, MyLine As String
FF = 0
FileNum = FreeFile ' next file number
' open the file & add currently selected data to the file (or create it)
Open FileSaveName For Append As #FileNum
'use output instead of append if you want to overwrite
'the entire file each time
For Each c In MyRange 'c=rows in range
'assuming five columns of data to be written to file
Print #FileNum, Cells(c.Row, c.Column).Text, _
Cells(c.Row, c.Column + 1).Text, Cells(c.Row, c.Column + 2) _
.Text, Cells(c.Row, c.Column + 3).Text, _
Cells(c.Row, c.Column + 4).Text
Next
Close #FileNum ' close the file
'MsgBox MyLine, vbInformation, "Last log information:"
End Sub

--

Dave Peterson

Notim to go through that lot.
Here is a way of getting the DeskTop folder of a machine :-

Code:
--------------------

Sub test()
'- using WinScript
Set objShell = CreateObject("WScript.Shell")
MyDeskTop = objShell.SpecialFolders.Item("DeskTop")
MsgBox (MyDeskTop)
End Sub

--------------------


--
BrianB


------------------------------------------------------------------------
BrianB's Profile: http://www.excelforum.com/member.php...info&userid=55
View this thread: http://www.excelforum.com/showthread...hreadid=387912