Как с помощью сценария vba отобразить гифку при изменении значения ячейки, а затем скрыть ее - PullRequest
0 голосов
/ 19 июня 2020

У меня есть электронная таблица с таблицей, в которой ячейки столбца «F» могут принимать разные значения: мне нужно отображать gif только тогда, когда значение равно «ГОТОВО». После этого события, щелкнув гифку, я хотел бы скрыть ее, чтобы продолжить обновление значений других строк в столбцах F и, если значение другой ячейки равно «ГОТОВО», повторить отображение гифки. Я собрал код, выполнив поиск по net, но он не завершен и работает не так, как хотелось бы (у меня недостаточно опыта). Я также не знаю, нужно ли мне вставлять гифку в свой рабочий лист с опцией «вставить картинки» или как «объект». Здесь ниже начальный код, добавленный к другому фрагменту макроса, который я уже использовал:

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

1 Ответ

0 голосов
/ 21 июня 2020

Примерно так:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...