Ir ao conteúdo
  • Cadastre-se
Ayr

Outro RESOLVIDO Mensagens Personalizadas em Botões Excel VBA

Recommended Posts

Boa noite!

Tenho uma planilha no Excel que contém 2 botões. Um para inserir imagens e outro para retornar à página inicial.

Quando eu for bloquear a planilha para edições, gostaria que o botão para inserir imagens retornasse uma mensagem personalizada de erro (Ex.: Entre em contato com o administrador) se alguém tentasse utilizá-lo.

Alguém poderia me ajudar com um código para essa solução?

Abaixo está o código do botão para inserir imagem que uso na minha planilha.

Quando ela está bloqueada e uso este botão ele abre a caixa de inserção de imagens e me deixa selecionar uma imagem mas o confirmar a inserção ele retornar com o erro 1004 já com a opção de depurar bloqueada (excelente até aí, mas eu gostaria de uma mensagem personalizada):

Erro em tempo de execução '1004':

Não é possível obter a propriedade Insert da classe Pictures.

Sub inserir_imagem()
    Dim Pict
    Dim Imagem As Object
    Dim ImgFileFormat As String
    ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
    Pict = Application.GetOpenFilename(ImgFileFormat)
    If Pict = False Then End
    Set Imagem = ActiveSheet.Pictures.Insert(Pict)
    Imagem.Top = ActiveCell.Top
    Imagem.Left = ActiveCell.Left
    Imagem.ShapeRange.LockAspectRatio = msoFalse
    '12 = Quantidade de linhas...
    Imagem.Height = ActiveCell.Height * 12
    '5 = Quantidade de colunas...
    Imagem.Width = ActiveCell.Width * 5
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Vejas se é isso que deseja.

 

Sub inserir_imagem()
    Dim Pict
    Dim Imagem As Object
    Dim ImgFileFormat As String
    ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
    Pict = Application.GetOpenFilename(ImgFileFormat)
    If Pict = False Then End
    
    On Error GoTo tratarErro
    
    Set Imagem = ActiveSheet.Pictures.Insert(Pict)
    Imagem.Top = ActiveCell.Top
    Imagem.Left = ActiveCell.Left
    Imagem.ShapeRange.LockAspectRatio = msoFalse
    '12 = Quantidade de linhas...
    Imagem.Height = ActiveCell.Height * 12
    '5 = Quantidade de colunas...
    Imagem.Width = ActiveCell.Width * 5
    Exit Sub
tratarErro:
    MsgBox "Este Recurso não está Disponível no Momento! Entre em Contato com o Administrador", 64, "Administrador "
 On Error GoTo 0
End Sub

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Maravilha!

Exatamente o que eu precisava.

Muito obrigado!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×