Este fórum está sendo desativado

[crcjcruz]

Bom dia a todos.
Tenho uma planilha bem simples para pesquisa se salas comerciais, dentro dessa planilha tenho quatro imagens e gostaria de quando clicar em uma dessas quatro imagem ela me apresenta em tamanho maior, ou seja ela se amplia, e ao clicar novamente ela retorna ao seu tamanho normal. Alguém pode me ajudar ?
Segue anexo exemplo.

[alexandrevba]

Bom dia!!

Eu não baixei seu modelo.

===================[Opção 1]=========================

Código: Selecionar todos

Option Explicit

'Autor: Domenic Domenic (MrExcel MVP)
'Fonte: https://www.mrexcel.com/forum/excel-questions/611678-macro-zoom-picture.html

Private Sub Picture_Click()

    Static Dict As Dictionary
    Static MyPics() As Variant
    Static Cnt As Long
    Static c As Long
    
    Dim SHP As Shape
    
    Cnt = Cnt + 1
    
    If Cnt = 1 Then
        Set Dict = CreateObject("Scripting.Dictionary")
    End If
    
    Set SHP = Me.Shapes(Application.Caller)
    
    If Not Dict.Exists(SHP.Name) Then
        c = c + 1
        Dict.Add SHP.Name, c
        ReDim Preserve MyPics(1 To 2, 1 To c)
        MyPics(1, c) = SHP.Name
        MyPics(2, c) = True
    End If
    
    If MyPics(2, Dict.Item(SHP.Name)) = True Then
        MyPics(2, Dict.Item(SHP.Name)) = False
        SHP.ScaleHeight 1.5, msoTrue 'aumentar a altura para 50%
        SHP.ScaleWidth 1.5, msoTrue 'aumentar a largura para 50%
    Else
       MyPics(2, Dict.Item(SHP.Name)) = True
        SHP.ScaleHeight 1, msoTrue 'escala para altura original
        SHP.ScaleWidth 1, msoTrue 'escala para largura original
    End If

End Sub

Código: Selecionar todos

Sub AssignMacro()
'Click com o direito do mouse e seleciona a opção Atribuir Macro
    Dim SHP As Shape
    For Each SHP In Plan1.Shapes 'Altere o nome da guia caso necessário
        If SHP.Type = 13 Then 'imagem
            SHP.OnAction = "Plan1.Picture_Click"
        End If
    Next SHP
End Sub

Código: Selecionar todos

Sub ResetToOriginalSize()
'Coloque esse código dentro de um Módulo comum
    Dim SHP As Shape
    For Each SHP In Plan1.Shapes
        If SHP.Type = 13 Then 'imagem
            SHP.ScaleHeight 1, msoTrue 'scale to original height
            SHP.ScaleWidth 1, msoTrue 'scale to original width
        End If
    Next SHP
End Sub

Código: Selecionar todos

Private Sub Workbook_Open()
'Coloque esse código dentro do módulo de EstaPasta_de_trabalho
    Call ResetToOriginalSize
End Sub

===================[Opção 2]=========================
Veja:
https://answers.microsoft.com/en-us/off ... 018acf6810
https://www.extendoffice.com/documents/ ... image.html

Att

[crcjcruz]

alexandrevba, bom dia.
Primeiramente obrigado pelo seu retorno, mas infelizmente não sou tão bom em VBA, mas tentei colocar o seus códigos, mas não funcionou, acho que estou fazendo alguma coisa errada, tentei gravar na macro mas me dá bastante erros.

[crcjcruz]

babdallas, bom dia.
Obrigado pelo seu retorno. Baixei seu exemplo, mas não funcionou, acho que está faltando algo, por favor pode verificar e me retornar

[babdallas]

Desculpe, anexei o arquivo errado. Veja se funciona agora.

[crcjcruz]

babdallas, bom dia.
Ok funcionou direitinho, como vi eu tenho que fazer imagem por imagem, como vou ter várias imagem tem como fazer um código para todas, desculpe estar tomando seu tempo, mas se for possível seria melhor, mas se não for tudo bem, fico com essa mesmo.

[babdallas]

Simplifiquei o que está ao alcance do meu conhecimento. Mas tem que atribuir a macro em cada imagem.

[crcjcruz]

OK funcionou corretamente, muito obrigado pela sua ajuda, valeu mesmo. Não sou bom em VBA, mas se precisar de algo estou a disposição.