Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Guardar .xls como .txt En Escritorio
Aquí está una pregunta simple (sospechoso que la respuesta no lo es..)
Este code guarda una parte del documento en al Dir A: como Text Nesecito que tambien guarde una copia en el escritonrio Thank's in Advance 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
como crear un curiculum vitae | Excel Discussion (Misc queries) | |||
¿como hago una gráfica en excel? | Excel Discussion (Misc queries) | |||
COMO ESCRIBO UN NOMBRE EN UNA FORMULA | Excel Worksheet Functions | |||
COMO CALCULAR EL PAGO DE IMPUESTOS | Excel Discussion (Misc queries) | |||
como inserir macros | Setting up and Configuration of Excel |