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.