Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

CODIGO QUE EXAMINE UNIDADES DE DISCO Y BUSQUE UN ARCHIVO

10/05/2008 - 06:52 por LUIS DANNY SALAS | Informe spam
Ayuda Hacer una pregunta
Hola gracias al que amablemente pueda ayudarme, tengo la macro COLEGA
necesito que en lugar de abrir el archivo NOTA.DBF en la unidad de
disquette( A:\)
busque la ubicacion de ese archivo sea en los discos duros o en algun medio
de almacenamiento externo (llave maya)
y lo abra.
es decir en lugar de abrirlo del disquette , que primero busque donde esta
antes de abrirlo, pues ese archivo puede estar en el disquette , en el disco
duro u en una llave maya.
gracias.


Private Sub COLEGA()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="A:\NOTA.DBF"
Range("A1:K5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
ThisWorkbook.Sheets("REGISTRO").Range("P165:V166"), CopyToRange:= _
Range("N1"), Unique:=False
ThisWorkbook.Activate
Sheets("CONCENTRADO").Select
Range("F11:F52").Select
Selection.Copy
Windows("NOTA.DBF").Activate
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
Application.CutCopyMode = False
Range("A62").Select
Selection.Copy
Windows("NOTA.DBF").Activate
Range("Z1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
Application.CutCopyMode = False
Windows("NOTA.DBF").Activate
Range("M2").Select
With Worksheets("NOTA")
If .[R2] <> "" Then
For Each celda In .Range("R2:R" & .[r65536].End(xlUp).Row)
If celda <> "" Then
celda.Copy
ActiveCell.PasteSpecial xlPasteAll
ActiveCell.Offset(1, 0).Activate
End If
Next
End If
End With
Range("M2").Select
Application.CutCopyMode = False
Windows("NOTA.DBF").Activate
With Range("a1:k5000")
.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=ThisWorkbook.Worksheets("registro").Range("p165:v166"),
_
Unique:=True
With .SpecialCells(xlCellTypeVisible)
On Error GoTo Ninguno
IIf(.Areas(1).Rows.Count > 1, _
.Areas(1).Cells(2, [Z1] + 2), .Areas(2).Cells(1, [Z1] + 2)).Select
End With
End With
ActiveSheet.ShowAllData
With Worksheets("nota")
.Range(.Range("M2"), .Range("M65536").End(xlUp)).Copy ActiveCell
End With
Ninguno:
Windows("NOTA.DBF").Activate
Range("O1:O38").Select
Selection.ClearContents
ActiveWorkbook.Save
ActiveWindow.Close
ThisWorkbook.Activate
Sheets("CONCENTRADO").Select
Range("D11").Select
Application.DisplayAlerts = True
MsgBox "LAS NOTAS HAN SIDO PASADAS AL DISQUETTE CON EXITO!"

End Sub
email Siga el debateRespuesta 12 respuestasRespuesta Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#11 LUIS DANNY SALAS
16/05/2008 - 19:01 | Informe spam
Saludos Hector, muchas Gracias por los codigos funcionaron a la perfeccion,
hoja de calculo cada vez esta mas completa y en en parte es mucho por tu
aydua, me gustaria un dia pudieras verla, muchas gracias.
en cuanto a la hora, no tnego idea, aqui en Costa Rica en este momento son
las 9 a.m, y mi computadora muestra la hora correcta< aqui no hay
estaciones, solo epoca seca y lluviosa y los dias y als noches duran siempre
lo mismo casi.
Gracias
"Héctor Miguel" wrote in message
news:ep7ayR%
hola, Luis !

Gracias, lo probare



[fuera de tema]...

o... la fecha/hora de tu sistema/pc trae un "adelanto" de 2 horas
o... tu pc/region no actualiza/comparte el ajuste con el "horario de
verano" -?-

saludos,
hector.

Respuesta Responder a este mensaje
#12 LUIS DANNY SALAS
16/05/2008 - 21:43 | Informe spam
Hola!! Muchas Gracias Hector tengo algo parecido:
esta macro que incluyo 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 como el de las anteriores para que el usuario seleccione la carpeta de
su agrado (que permita seleccionar inclusive unidades de almacenamiento
externo)donde quiere guardarlo y tambien le pueda poner el nombre que desee
al archivo .
He ntentado varios con los codigos que me diste para las otras macros pero
no me sale.
Muchas 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














"Héctor Miguel" wrote in message
news:ep7ayR%
hola, Luis !

Gracias, lo probare



[fuera de tema]...

o... la fecha/hora de tu sistema/pc trae un "adelanto" de 2 horas
o... tu pc/region no actualiza/comparte el ajuste con el "horario de
verano" -?-

saludos,
hector.

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