Me preguntaba una lectora por la forma de conseguir la propiedad de 'Dimensiones' de un fichero o imagen..
El asunto a priori no es fácil, pero construyendo una macro podremos recuperar de alguna forma, junto a otras propiedades informativas, dicho dato.
En un módulo estándar incluimos el siguiente procedimiento:
Si probamos la macro y elegimos una imagen cualquiera obtendremos:
Obteniendo una lista de propiedades asociadas al fichero seleccionado.
El asunto a priori no es fácil, pero construyendo una macro podremos recuperar de alguna forma, junto a otras propiedades informativas, dicho dato.
En un módulo estándar incluimos el siguiente procedimiento:
Sub DetallesFichero()
Dim objShell As Object, objFolder As Object, objFolderItem As Object
Dim strRutaCompleta As String 'para la ruta completa, incluido el nombre del fichero
Dim NombreFichero As String 'solo el nombre del fichero
Dim RutaCarpeta As Variant
Dim strCab As String 'la cabecera del MsgBox
Dim strTxt As String 'para la composicón del texto a devolver en el MsgBox
'Definimos la variable del fichero elegido
'mediante GetOpenFilename
'debe ser una imagen para poder recuperar las Dimenensiones
strRutaCompleta = Application.GetOpenFilename
'si no seleccionamos nada salimos del procedimiento
If strRutaCompleta = "False" Then Exit Sub
On Error GoTo ControlError
'asignamos la Ruta del fichero elegido
RutaCarpeta = Left(strRutaCompleta, Len(strRutaCompleta) - Len(Dir(strRutaCompleta, vbHidden + vbSystem)) - 1)
'y el nombre del fichero
NombreFichero = StrReverse(Left(StrReverse(strRutaCompleta), InStr(StrReverse(strRutaCompleta), "\") - 1))
On Error GoTo 0
'abrimos objeto Shell y definimos la Carpeta
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(RutaCarpeta)
'controlamos la ruta
If (Not objFolder Is Nothing) Then
'creamos y definimos un objeto como parte de la Carpeta
'.ParseName convierte en objeto un texto
Set objFolderItem = objFolder.ParseName(NombreFichero)
'En caso de que exista...
If (Not objFolderItem Is Nothing) Then
'...obtenemos los detalles/propiedades del fichero elegido
strCab = "Detalles de:= " & NombreFichero
strTxt = "Carpeta:=" & RutaCarpeta & vbCrLf
'con .GetDetailsOf obtenemos los detalles del fichero
MsgBox strTxt & objFolder.GetDetailsOf(objFolderItem, -1), vbExclamation, strCab
'el segundo parametro de .GetDetailsOf devuelve:
'-1 detalles informativos del elemento.
'0 nombre del elemento.
'1 tamaño.
'2 tipo.
'3 Fecha y hora última modificación.
'4 los atributos del elemento.
End If
End If
'liberamos memoria
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Exit Sub
ControlError:
'lanzamos mensaje de error en su caso
MsgBox Err.Number & ":" & Err.Description, vbInformation
End Sub
Si probamos la macro y elegimos una imagen cualquiera obtendremos:
Obteniendo una lista de propiedades asociadas al fichero seleccionado.



No hay comentarios:
Publicar un comentario
Nota: solo los miembros de este blog pueden publicar comentarios.