1

Na minha planilha eu tenho um botão que exibe a caixa de seleção de arquivos. Depois de selecionar uma imagem, esta é exibida em uma célula específica.

  1. Como faço para verificar se o arquivo escolhido é mesmo uma imagem? e
  2. Como limitar o tamanho dessa imagem (por exemplo se a imagem tiver mais de 500k o excel deve enviar uma mensagem informando o limite)?

Segue o código:

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

1 Resposta 1

0

Segue a solução adotada:

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

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .