Excel VBA - Check file size and type

Navigation
1

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

  • How do I check if the chosen file is really an image? and
  • How to limit the size of this image (for example if the image is more than 500k 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
        
    asked by anonymous 04.12.2017 / 13:54

    1 answer

    0

    Here is 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
        
    04.12.2017 / 14:34
    ASP.NET MVC 5: Linking two models to the view Pull branch request outdated in Git