简体   繁体   中英

How to display with a vba script a gif when the value of a cell changes, and then hide it

I have a spreadsheet with a table where the cells of the column "F" can assume different values: I need to show a gif only when the value is equal to "DONE". After that event, by clicking on the gif, I would like to hide it, in order to proceede to update the value of the other rows in the columns F and, if the value of another cell is equal to "DONE", repeat the display of the gif. I assembled a code by searching on the net, but it's not complete and it doesn't work as I would like (I don't have enough expertise). I don't know neither if in my worksheet I have to insert the gif with the "insert-pictures" option or as an "object". Here below the starting code, added to another piece of macro I've already used:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dgr As String
Dim n, i, ntab As Integer
Dim myImage As Shape
Dim imageWidth As Double


ntab = Range("B2").CurrentRegion.Rows.Count
For itab = 3 To ntab + 1
' Aim: show a animated gif when the content of a cell in the column "F" changes to "DONE"
        If Not Intersect(Target, Range("F" & itab)) Is Nothing Then
            Dim Sh As Shape
            For Each Sh In ActiveSheet.Shapes
                Sh.Top = 60
                Sh.Left = 189
                Sh.Visible = msoFalse
            Next
            dgr = Range("F" & itab).Value
            If dgr = DONE Then
                ActiveSheet.Shapes("Picture 1").Visible = True
            End If
        End If
' Script to update the today-date automatically if cell values in the columns E, F, G change
        If Not Intersect(Target, Range("E" & itab)) Is Nothing Then
        szTod = Format(Date, "MM-DD-YY")
        Range("H" & itab) = szTod
        End If
        If Not Intersect(Target, Range("F" & itab)) Is Nothing Then
        szTod = Format(Date, "MM-DD-YY")
        Range("H" & itab) = szTod
        End If
        If Not Intersect(Target, Range("G" & itab)) Is Nothing Then
        szTod = Format(Date, "MM-DD-YY")
        Range("H" & itab) = szTod
        End If
Next itab
End Sub

Something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    Set rng = Application.Intersect(Me.Columns("F"), Target)
    If Not rng Is Nothing Then
        If rng.Row >= 3 And rng.Value = "DONE" Then
            With Me.Shapes("Picture 1")
                .Visible = True
                .Left = rng.Offset(0, 1).Left
                .Top = rng.Offset(0, 1).Top
            End With
        End If
    End If

End Sub

'assign this macro to the shape
Sub HideMe()
    Me.Shapes("Picture 1").Visible = False
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM