Autor
Código
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Picture1.Cls
mensaje = CommonDialog1.FileTitle
Me.Picture1.Print mensaje
Else
Picture1.Cls
mensaje = "No se seleccionó ningún archivo"
Me.Picture1.Print mensaje
el caso es que esto me sirve para solo 1 archivo,si vuelvo a seleccionar otro me remplaza la primera línea de texto del picturebox.
Lo que necesito saber es como puedo hacer para que en el commondialog pueda seleccionar varios archivos y al seleccionarlos cuente el número de archivos que se han seleccionado y haga X lineas de texto en el picturebox. ¿Cómo podría hacer esto? Gracias
EDIT: he encontrado éste código que sirve para seleccionar varios archivos en através de common dialog y luego los añade en un listbox.
Código
Option Explicit
' Colección para guardar los archivos
Dim mColFiles As Collection
' -----------------------------------------------------------------------------------
' \\ - Sub para agregar los archivos a la colección
' -----------------------------------------------------------------------------------
Private Sub mAddFiles(arrFiles() As String)
On Local Error GoTo error_handler
With mColFiles
' Si el array tiene un solo elemento, es por que se seleccionó un solo fichero ( Es decir Contiene la ruta completa : Dir + FileName)
If UBound(arrFiles) = 0 Then
' Comprobar que la colección tiene elementos ...
If .Count > 0 Then
Call .Add(arrFiles(0), arrFiles(0), 1) ' agregar item en el primer lugar
' si no hay elementos ...
Else
Call .Add(arrFiles(0), arrFiles(0))
End If
' Si no, Hay mas de un archivo ....
Else
' El primer elemento del array es el directorio ( Guardar el path en la variable )
Dim sDir As String
sDir = arrFiles(0)
' verificar el separador de path
If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
' Los archivos ( solo el nombre sin el path )
Dim i As Integer
For i = 1 To UBound(arrFiles)
' REcorrer el array y agregarlos a la colección
If .Count > 0 Then
Call .Add(sDir & arrFiles(i), sDir & arrFiles(i), 1) 'agregar primero
Else
Call .Add(sDir & arrFiles(i), sDir & arrFiles(i))
End If
Next
End If
End With
Exit Sub
error_handler:
If Err.Number = 457 Then
Resume Next ' ignorar error cuando se agrega el mismo archivo
Else
MsgBox Err.Description
End If
End Sub
' -----------------------------------------------------------------------------------
' \\ - Botón para seleccionar los archivos
' -----------------------------------------------------------------------------------
Private Sub cmdAddFiles_Click()
On Local Error Resume Next
' Configurar el cuadro de diálogo
' ---------------------------------------------------------
With CD
' Limpiar la propiedad FileName
.FileName = vbNullString
' Establecer Flag para poder seleccionar múltiples archivos desde el cd
.Flags = .Flags Or cdlOFNExplorer Or cdlOFNAllowMultiselect
' Tamaño de Buffer para el FileName
.MaxFileSize = 32767 ' <- máximo 32 K
' Establecer filtro
.Filter = "Todos los Archivos|*.*"
' Abrir
.ShowOpen
' Verificar que el FileName no sea una cadena vacía
If .FileName <> vbNullString Then
' Array para obtener las rutas
Dim arrPaths() As String
arrPaths = Split(.FileName, Chr(0))
' Enviar array de archivos para agregar a la colección
Call mAddFiles(arrPaths)
Erase arrPaths
' Actualizar listado
Call mUpdateList(lstFiles)
End If
.FileName = vbNullString
End With
' Error
Exit Sub
error_handler:
MsgBox Err.Description, vbCritical
End Sub
' -----------------------------------------------------------------------------------
' \\ - Actualizar el contenido del listbox
' -----------------------------------------------------------------------------------
Private Sub mUpdateList(lBox As ListBox)
With lBox
' limpiar listbox y volver a cargar
.Clear
Dim xItem As Variant
' recorrer items de la colección
For Each xItem In mColFiles
.AddItem CStr(xItem)
Next
' seleccionar el primero
If .ListCount > 0 Then
.ListIndex = 0
.SetFocus
End If
End With
End Sub
' -----------------------------------------------------------------------------------
' \\ - Eliminar todo
' -----------------------------------------------------------------------------------
Private Sub cmdClear_Click()
Set mColFiles = Nothing
Set mColFiles = New Collection
Call mUpdateList(lstFiles)
End Sub
' -----------------------------------------------------------------------------------
' \\ - Eliminar selección
' -----------------------------------------------------------------------------------
Private Sub cmdDelete_Click()
Dim i As Integer
' recorrer items y comprobar si se encuentran seleccionados
With lstFiles
For i = 0 To .ListCount - 1
If .Selected(i) Then
Call mColFiles.Remove(.List(i)) ' eliminar con el método Remove el item de la colección
End If
Next
End With
' volver a cargar los items en el control
Call mUpdateList(lstFiles)
End Sub
Private Sub Form_Load()
' Crear nueva colección para guardar los archivos
Set mColFiles = New Collection
cmdAddFiles.Caption = "Agregar archivos"
cmdDelete.Caption = "Eliminar selección"
cmdClear.Caption = "Eliminar todo"
End Sub
Este código me sería muy útil si me sacara sólo los nombres de los archivos y no la ruta de los archivos seleccionados,pero si cambio el .FileName por .FileTitle me da error y no me deja. ¿Alguien sabe porque? Gracias
En línea
