Excel VBA - Check size and file type



  • In my worksheet I have a button that displays the file selection box. After selecting an image, this is displayed in a specific cell.

    1. How do I check if the chosen file is really an image? and
    2. How to limit the size of this image (e.g. if the image has more than 500k the excel should send a message stating the limit)?

    Follow the code:

    Sub InserirFoto()
        'Função acionada ao clicar no botão
        escolherFoto ("B17")
    End Sub
    

    Public Function escolherFoto(cellRef As String) As String

    Dim intChoice As Long
    Dim strPath As String
    
    'Só permite que o usuário selecione um arquivo
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    'exibe a caixa de seleção de arquivo
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    If intChoice <> 0 Then
    
        strPath = Application.FileDialog( _
                  msoFileDialogOpen).SelectedItems(1)
    
        escolherFoto = setImage(strPath, cellRef)
    End If
    

    End Function

    Public Function setImage(strPath As String, cellRef As String) As String

    Dim sFile As String
    Dim oSheet As Worksheet
    Dim oCell As Range
    Dim oImage As Shape
    
    Set oCell = Range(cellRef)
    Set oSheet = oCell.Parent      ' Planilha que chamou a função
    
    ' Exclui a imagem se já houver uma
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = oCell.Address Then sh.Delete
    Next
    
    Set oImage = oSheet.Shapes.AddPicture(strPath, msoCTrue, msoCTrue, oCell.Left, oCell.Top, oCell.Width, oCell.Height)
    
    With oImage
        .Left = oCell.Left
        .Top = oCell.Top
        .Width = oCell.Width
        .Height = oCell.Height
    End With
    
    ' Retorna nada para a célula (afinal, esta é somente uma função de auxílio)
    getImage = strPath
    

    End Function



  • Follow the solution adopted:

    Public Function escolherFoto(cellRef As String) As String
        'Créditos: http://software-solutions-online.com/excel-vba-open-file-dialog/
        Dim intChoice As Long
        Dim strPath As String
    
    Dim iFileSelect As FileDialog
    Set iFileSelect = Application.FileDialog(msoFileDialogOpen)
    
    With iFileSelect
        .AllowMultiSelect = False
        .Title = "Selecione uma foto"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg,*.jpeg,*.bmp,*.png"
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then
            strPath = iFileSelect.SelectedItems(1)
            escolherFoto = setImage(strPath, cellRef)
        End If
    End With
    

    End Function

    Public Function setImage(strPath As String, cellRef As String) As String

    If FileLen(strPath) < 512000 Then
        MsgBox "O arquivo da foto deve ter um tamanho menor do que 500KB", , "Tamanho inválido", Err.HelpFile, Err.HelpContext
        Exit Function
    End If
    
    Dim sFile As String
    Dim oSheet As Worksheet
    Dim oCell As Range
    Dim oImage As Shape
    
    Set oCell = Range(cellRef)
    Set oSheet = oCell.Parent      ' Planilha que chamou a função
    
    ' Exclui a imagem se já houver uma
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = oCell.Address Then sh.Delete
    Next
    
    Set oImage = oSheet.Shapes.AddPicture(strPath, msoCTrue, msoCTrue, oCell.Left, oCell.Top, oCell.Width, oCell.Height)
    
    With oImage
        .Left = oCell.Left
        .Top = oCell.Top
        .Width = oCell.Width
        .Height = oCell.Height
    End With
    
    ' Retorna nada para a célula (afinal, esta é somente uma função de auxílio)
    getImage = strPath
    

    End Function




Suggested Topics

  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2