Jak zvětšit nebo zmenšit obrázek jedním kliknutím v aplikaci Excel?

Předpokládejme, že na listu je více obrázků, které jsou v různých velikostech. Máte nějaké způsoby, jak tyto obrázky zvětšit nebo zmenšit v jedné velikosti jedním kliknutím? Neexistuje žádná vestavěná funkce, která by to vyřešila, ale v tomto článku představuji kód VBA pro zvětšení nebo zmenšení všech obrázků v listu jedním kliknutím.

Zvětšujte a zmenšujte obrázky jedním kliknutím pomocí VBA

Zvětšujte a zmenšujte obrázky jedním kliknutím pomocí VBA

Chcete-li zvětšit nebo zmenšit obrázky jedním kliknutím, proveďte níže uvedené kroky.

1. Klikněte pravým tlačítkem na záložku listu, kde chcete změnit velikost obrázků, a vyberte Zobrazit kód z kontextového menu.

2. V praskání Microsoft Visual Basic pro aplikacis a vložte pod kód do prázdného skriptu.

VBA: Zvětšujte a zmenšujte obrázky jedním kliknutím

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'UpdatebyEntendoffice20161111
    Application.ScreenUpdating = False
    Dim xRg As Range, sPic As Shape
      For Each sPic In ActiveSheet.Shapes
        If Target.Column > 1 Then
            Set xRg = Target.Offset(, -1)
            With sPic
              If TypeName(.OLEFormat.Object) = "Picture" Then
                  If .TopLeftCell.Address = xRg.Address Then
                      .Height = 350
                      .Width = 250
                  End If
              End If
            End With
        ElseIf Target.Column = 1 Then
            With sPic
                If TypeName(.OLEFormat.Object) = "Picture" Then
                   .Height = 60
                   .Width = 60
                End If
            End With
        End If
      Next sPic
    Application.ScreenUpdating = True
End Sub

3. Uložte kód a zavřete okno. A když kliknete na kteroukoli buňku ve sloupci A, všechny obrázky se zmenší. Viz snímek obrazovky:

4. A když kliknete na buňku v pravé horní části obrázku, relativní obrázek se zvětší. Viz snímek obrazovky:

Spropitné. Pokud chcete rychle vložit vodoznak do listu, zkuste použít Kutools pro Excel Vložit vodoznak jak je znázorněno na následujícím snímku obrazovky.