Buenas! Tengo diseñado un Userform, en el cual quiero meter un boton, que seleccione una carpeta de mi disco. Y que la ruta de esta carpeta me la indique en un label Una vez echo esto, tendría una lista desplegable con los archivos
1 respuesta
Respuesta de Claudio Cruz
1
1
Claudio Cruz, Es mejor encender una vela que maldecir la oscuridad
A ver, tengo un codigo que puede ayudarte, lo que necesitas es: Un formulario con un boton de comando, etiqueta, un combobox y otro boton de comando para cerrar el formulario. El codigo para el formulario es: Private Sub cmdGetDir_Click() Workbooks("Factura.xls").Activate ActiveWorkbook. Sheets("Sheet4"). Activate Application. GetSaveAsFilename,,, "Seleccione la ruta" Me.Label1.Caption = CurDir Range("B5").Select With ActiveCell .Value = CurDir .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .IndentLevel = 1 .Font.Color = RGB(128, 0, 0) .Font.Bold = True End With Call ListArchivos Call dRanArch Sheets("Sheet5").Visible = True ActiveWorkbook.Sheets("Sheet5").Activate Application.Goto reference:="RanArchivos" RanLista = Selection.Address With Me.cmbLista .Value = "" .RowSource = RanLista .BackColor = RGB(240, 242, 239) .ForeColor = RGB(0, 0, 136) End With Sheets("Sheet5").Visible = False Range("A1").Activate End Sub Private Sub CommandButton1_Click() Unload Me End Sub Sub ListArchivos() On Error Resume Next Application.ScreenUpdating = False Set fso = CreateObject("Scripting.FileSystemObject") ruta = UserForm2.Label1.Caption Set directorio = fso.GetFolder(ruta) Set ficheros = directorio.Files ActiveWorkbook.Sheets("Sheet5").Visible = True ActiveWorkbook.Sheets("Sheet5").Activate Range("A1").Select ActiveCell = "Ficheros del directorio:" ActiveCell.Font.Bold = True ActiveCell.Font.Underline = xlUnderlineStyleSingle Range("A2").Select For Each archivo In ficheros ActiveCell = archivo.Name ActiveCell.Offset(1, 0).Select Next Set fso = Nothing Set directorio = Nothing Set ficheros = Nothing Application.ScreenUpdating = True ActiveWorkbook.Sheets("Sheet5").Visible = False End Sub Private Sub dRanArch() Dim rpIni$, rpFin$ rpIni = "A2" Sheets("Sheet5").Visible = True ActiveWorkbook.Sheets("Sheet5").Activate Range(rpIni).Select Do If IsEmpty(ActiveCell) = False Then ActiveCell.Offset(1, 0).Select End If Loop Until IsEmpty(ActiveCell) = True rpFin = ActiveCell.Offset(-1, 0).Address ActiveWorkbook.Names.Add Name:="RanArchivos", RefersToR1C1:=Range(rpIni, rpFin) Sheets("Sheet5").Visible = False Sheets("Sheet4").Activate End Sub Private Sub UserForm_Initialize() Call dRanArch Sheets("Sheet5").Visible = True ActiveWorkbook.Sheets("Sheet5").Activate Application.Goto reference:="RanArchivos" RanLista = Selection.Address With Me.cmbLista .Value = "" .RowSource = RanLista .BackColor = RGB(240, 242, 239) .ForeColor = RGB(0, 0, 136) End With Me.cmdGetDir.SetFocus Sheets("Sheet5").Visible = False End Sub Lo he probado y me ha funcionado muy bien. P.D. Si tu duda ha sido resuelta, no olvides finalizar la pregunta.
No consigo echarlo a andar, no encuentra la macro..... eso pone.. habria la posibilidad que me mandaras un ejemplo?¿ Un saludo, gracias por el interes!
Claro, solo enviame una direccion electronica a donde enviarte el ejemplo. Es probable que el error que te marca sea porque la macro hace uso de una hoja oculta, pero en el ejemplo ya la he incluido para que la macro este funcional, solo dime a donde te lo envio.