How to hide pictures in excel VBA?

Question

I have read an answer from Insert picture into excel cell

However, my Excel is a starter version which does not have "Colors and Lines " under "Format Comment"

I want to put my pictures into column H. Whenever I click on the cell, then the picture will enlarge. Possible?

Note: I have NO vba experience

score 1 · Answer 1 · answered May 15 '14 at 06:05

You add a picture (Name Picture 1) where you want. Add the follow code to the Sheet1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Prev Then
        Dim x
        x = ActiveCell.Address
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
        Prev = False
        Range(x).Select
    End If
End Sub

and in a module (inside VBA Alt+F11 -> rightclick on : Sheet1 -> Insert -> module):

Public Prev As Boolean

Sub Macro1()
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
    Prev = True
End Sub

Assign to the picture the macro Macro1...(right mouse click on the picture -> Assign Macro)
When you click on the picture the picture enlarge, when you click on another cell, the picture reduce.

user3588043 · Answer 2 · 2014-05-15T11:39:16.410

Put picture to column H by selecting row number from combobox list, and fit picture to cell with align to center point, saving aspectratio

Private Sub ComboBox1_Change()
    PTstop = Me.ComboBox1.value
    PicPath = Worksheets("Sheet1").Application.GetOpenFilename("*.jpg,*.png,*.jpeg,*.gif")
                    If PicPath <> False Then
                        With .Pictures.Insert(Filename:=PicPath)
                            With .ShapeRange
                                If .Width > .Height Then
                                    If .Height >= Worksheets("Sheet1").Cells(PTstop, 8).Height Then
                                        .Height = Worksheets("Sheet1").Cells(PTstop, 8).Height
                                        If .Width >= Worksheets("Sheet1").Cells(PTstop, 8).Width Then
                                            .Width = Worksheets("Sheet1").Cells(PTstop, 8).Width 
                                        Else
                                        End If
                                    Else
                                        .Width = Worksheets("Sheet1").Cells(PTstop, 8).Width
                                        If .Height >= Worksheets("Sheet1").Cells(PTstop, 8).Height Then
                                            .Height = Worksheets("Sheet1").Cells(PTstop, 8).Height
                                        Else
                                        End If
                                    End If
                                Else
                                    .Height = Worksheets("Sheet1").Cells(PTstop , 8).Height
                                End If
                                .Top = Worksheets("Sheet1").Cells(PTstop, 8).Top + Worksheets("Sheet1").Cells(PTstop , 8).Height / 2 - .Height / 2
                                .Left = Worksheets("Sheet1").Cells(PTstop, 8).Left + Worksheets("Sheet1").Cells(PTstop, 8).Width / 2 - .Width / 2

                            End With
                        End With
                    End If
End Sub

Code to enlarge image then clicked to Right of Image, if click anywhere in column A, image should reduce in size. Not tested just as starting point.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rangeS As Range, picSelected As Shape, old
If Target.Column > 1 Then
    Set rangeS = Target.Offset(, -1)
        For Each picSelected In ActiveSheet.Shapes
            If TypeName(picSelected.OLEFormat.Object) = "Picture" Then
                If picSelected.TopLeftCell.Address = rangeS.Address Then
                    picSelected.Height = 250
                    picSelected.Width = 250
                End If
            End If
        Next picSelected
ElseIf Target.Column = 1 Then
    For Each picSelected In ActiveSheet.Shapes
       If TypeName(picSelected.OLEFormat.Object) = "Picture" Then
           With picSelected
                            If .Width > .Height Then
                                If .Height >= Target.Height Then
                                    .Height = Target.Height
                                Else
                                    .Width = Target.Width
                                    If .Height >= Target.Height Then
                                        .Height = Target.Height
                                    Else
                                    End If
                                End If
                            Else
                                .Height = Target.Height
                            End If
                            .Top = Target.Top + Target.Height / 2 - .Height / 2
                            .Left = Target.Left + Target.Width / 2 - .Width / 2

End With
       End If
   Next picSelected
End If
End Sub

How to hide pictures in excel VBA?

2 Answers2