PODER SELECCIONAR EL DIRECTORIO DONDE GUARDAR.

16/05/2008 - 21:40 por LUIS DANNY SALAS | Informe spam
Hola!! Muchas Gracias:
tengo esta macro:
para mis efectos trabaja bien pero salva el archivo en C:/ y lo que quisiera
es que al ejecutar la macro aparezca un cuadro de texto para que el usuario
seleccione la carpeta de su agrado donde quiere guardarlo y tambien le pueda
poner el nombre que desee al archivo .
He ntentado varios pero no me sale.
Gracias



Private Sub CONCENTRADO()
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ThisWorkbook.Activate
Range("C6:F52").Select
Selection.Copy
Windows("CONCENTRADO").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("C6").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ESBLANCO($B6)=VERDADERO"
Selection.FormatConditions(1).Font.ColorIndex = 2
Range("C6").Select
Selection.Copy
Range("C7:C47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C6").Select
Selection.Copy
Range("A6:A47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B6").Select

ThisWorkbook.Activate
Range("E5").Select
Selection.Copy
Windows("CONCENTRADO.xls").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C1:C3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D6:D57").Select
Selection.NumberFormat = "0"
Range("B6").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayAlerts = False
ChDir "C:\"
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
MsgBox " Se ha creado un archivo en C:/ asignele el nombre de la sección y
paselo a la carpeta de su gusto"
ThisWorkbook.Activate
Range("D11").Select
End Sub

Preguntas similare

Leer las respuestas

#1 Monica May
17/05/2008 - 01:28 | Informe spam
Hola,


para mis efectos trabaja bien pero salva el archivo en C:/ y lo que
quisiera es que al ejecutar la macro aparezca un cuadro de texto para que
el usuario seleccione la carpeta de su agrado donde quiere guardarlo y
tambien le pueda poner el nombre que desee al archivo .





Puedes utilizar la propiedad [ Dialogs] >>

'[]

Sub demo()

Dim respuesta As Boolean

respuesta = Application.Dialogs(xlDialogSaveWorkbook).Show

If respuesta Then
MsgBox "okeis guardado"
Else
MsgBox "not ha cancelado"
End If


End Sub
'[]

y acomodarlo a tu necesidad ...

Comentanos...!!

Saludos
Monica


codigo consulta --
Private Sub CONCENTRADO()
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ThisWorkbook.Activate
Range("C6:F52").Select
Selection.Copy
Windows("CONCENTRADO").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("C6").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ESBLANCO($B6)=VERDADERO"
Selection.FormatConditions(1).Font.ColorIndex = 2
Range("C6").Select
Selection.Copy
Range("C7:C47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C6").Select
Selection.Copy
Range("A6:A47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B6").Select

ThisWorkbook.Activate
Range("E5").Select
Selection.Copy
Windows("CONCENTRADO.xls").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C1:C3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D6:D57").Select
Selection.NumberFormat = "0"
Range("B6").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayAlerts = False
ChDir "C:\"
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
MsgBox " Se ha creado un archivo en C:/ asignele el nombre de la sección
y paselo a la carpeta de su gusto"
ThisWorkbook.Activate
Range("D11").Select
End Sub


email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida