Effacer contenu cellule automatiquement

Le 27/01/2019 à 09:15

salut

J'ai une macro qui montre une image si une cellule (disons G10) est remplie. et si la cellule est vide alors l'image devient invisible.

La macro fonctionne bien lorsque j'efface manuellement la valeur de la cellule G10 en effet l'image devient invisible.

Le problème commence lorsque j'essaie d'automatiser l'effacement de G10.

J'ai essayé avec range("g10')= " ", et aussi avec range("g10").clearcontents

Mais à chaque fois excel se ferme et s'ouvre sous mode "reparé". Quelque chose bug et je ne sais pas quoi ?

Je voudrais en fait qu'automatiquement, si la valeur de G8 est vide (sans rien dedans), alors la valeur de G10 s'efface tout simplement.

et donc par voie de fait, l'image qui est liée au contenu de la cellule G10 devient invisible en conséquence.

Est-ce possible?

Sub Worksheet_Change(ByVal Target As Range)

If IsEmpty(ThisWorkbook.Sheets("Sheet1").Range("G8").Value) = True Then
[b]ThisWorkbook.Sheets("Sheet1").Range("G10") = " "[/b]   ' clear contents of cell G10

ThisWorkbook.Sheets("Sheet1").Range("A10:L18").Font.Color = vbWhite
ThisWorkbook.Sheets("general").Visible = False
ThisWorkbook.Sheets("general2").Visible = False
ThisWorkbook.Sheets("general3").Visible = False
ThisWorkbook.Sheets("general4").Visible = False
ThisWorkbook.Sheets("general5").Visible = False
ThisWorkbook.Sheets("daily").Visible = False
ThisWorkbook.Sheets("daily2").Visible = False
ThisWorkbook.Sheets("daily3").Visible = False
ThisWorkbook.Sheets("daily4").Visible = False
ThisWorkbook.Sheets("daily5").Visible = False

Else
End If

If ThisWorkbook.Sheets("Sheet1").Range("G8").Value = 1 Then
ThisWorkbook.Sheets("Sheet1").Range("a10:L10").Font.Color = vbBlack
ThisWorkbook.Sheets("Sheet1").Range("a12:L18").Font.Color = vbWhite
ThisWorkbook.Sheets("general").Visible = True
ThisWorkbook.Sheets("general2").Visible = False

ThisWorkbook.Sheets("general3").Visible = False

ThisWorkbook.Sheets("general4").Visible = False

ThisWorkbook.Sheets("general5").Visible = False

Else
End If

If ThisWorkbook.Sheets("Sheet1").Range("G8").Value = 2 Then
ThisWorkbook.Sheets("Sheet1").Range("a10:L14").Font.Color = vbBlack
ThisWorkbook.Sheets("Sheet1").Range("a15:L18").Font.Color = vbWhite
ThisWorkbook.Sheets("general").Visible = True

ThisWorkbook.Sheets("general2").Visible = True

ThisWorkbook.Sheets("general3").Visible = False

ThisWorkbook.Sheets("general4").Visible = False

ThisWorkbook.Sheets("general5").Visible = False

Else
End If

If ThisWorkbook.Sheets("Sheet1").Range("G8").Value = 3 Then
ThisWorkbook.Sheets("Sheet1").Range("a10:L15").Font.Color = vbBlack
ThisWorkbook.Sheets("Sheet1").Range("a16:L18").Font.Color = vbWhite
ThisWorkbook.Sheets("general").Visible = True

ThisWorkbook.Sheets("general2").Visible = True

ThisWorkbook.Sheets("general3").Visible = True

ThisWorkbook.Sheets("general4").Visible = False

ThisWorkbook.Sheets("general5").Visible = False

Else
End If

If ThisWorkbook.Sheets("Sheet1").Range("G8").Value = 4 Then
ThisWorkbook.Sheets("Sheet1").Range("a10:L16").Font.Color = vbBlack
ThisWorkbook.Sheets("Sheet1").Range("a17:L18").Font.Color = vbWhite
ThisWorkbook.Sheets("general").Visible = True

ThisWorkbook.Sheets("general2").Visible = True

ThisWorkbook.Sheets("general3").Visible = True

ThisWorkbook.Sheets("general4").Visible = True

ThisWorkbook.Sheets("general5").Visible = False

Else
End If

If ThisWorkbook.Sheets("Sheet1").Range("G8").Value = 5 Then
ThisWorkbook.Sheets("Sheet1").Range("a10:L18").Font.Color = vbBlack
ThisWorkbook.Sheets("general").Visible = True

ThisWorkbook.Sheets("general2").Visible = True

ThisWorkbook.Sheets("general3").Visible = True

ThisWorkbook.Sheets("general4").Visible = True

ThisWorkbook.Sheets("general5").Visible = True

Else
End If

  With ActiveSheet.Pictures("Picture1") ' hide eye hotel1

If ActiveSheet.Range("G10").Value = 0 Then

 .Visible = False
  Else
.Visible = True
 End If
End With

With ActiveSheet.Pictures("Picture2") ' hide eye hotel2

If ActiveSheet.Range("F14").Value = 0 Then

 .Visible = False
  Else
.Visible = True
 End If
End With

With ActiveSheet.Pictures("Picture3") ' hide eye hotel3

If ActiveSheet.Range("F15").Value = 0 Then

 .Visible = False
  Else
.Visible = True
 End If
End With

With ActiveSheet.Pictures("Picture4") ' hide eye hotel4

If ActiveSheet.Range("F16").Value = 0 Then

 .Visible = False
  Else
.Visible = True
 End If
End With

With ActiveSheet.Pictures("Picture5") ' hide eye hotel5

If ActiveSheet.Range("F17").Value = 0 Then

 .Visible = False
  Else
.Visible = True
 End If
End With

 End Sub
18rooming-list.xlsm (671.83 Ko)
Le 27/01/2019 à 20:45

Salut ericw,

premier jet de chez premier jet tant certains trucs me chiffonnent...

Mais bon, c''est toi qui sait...

Ci-dessous, le code revisité de ta Sub Worksheet_Change de la feuille 'Sheet1' : on commence par un changement en [G8].

Sub Worksheet_Change(ByVal Target As Range)
'
Dim sData$
'
If Target = "" Then Exit Sub
Application.EnableEvents = False
'
If Not Intersect(Target, Range("G8")) Is Nothing Then
    Range("A10:L18").Font.Color = vbWhite
    For x = 1 To IIf([G8] = "" Or [G8] = 0, Sheets.Count, 5)
        If [G8] = "" Or [G8] = 0 And x > 5 And Sheets(x).Name <> ActiveSheet.Name Then Sheets(x).Visible = False
        If x <= 5 Then
            sData = "general" & IIf(x = 1, "", Trim(Str(x)))
            Worksheets(sData).Visible = IIf([G8] > 0 And x <= [G8], True, False)
            Shapes("Picture" & Trim(Str(x))).Visible = IIf([G8] > 0 And x <= [G8], True, False)
        End If
    Next
    If [G8] > 0 Then Range("A10:L" & IIf([G8] = 1, 10, 12 + [G8])).Font.Color = vbBlack
End If
'
Application.EnableEvents = True
'
End Sub

A+

Le 29/01/2019 à 15:00

merci!!

Rechercher des sujets similaires à "effacer contenu automatiquement"