Référence circulaire

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Y
Yoyo01000
Membre fidèle
Membre fidèle
Messages : 201
Appréciations reçues : 5
Inscrit le : 19 décembre 2018
Version d'Excel : 2016

Message par Yoyo01000 » 24 janvier 2019, 14:10

Re,

quand je tape du texte en A2, ton code fonctionne
quand je tape du texte en A3, les bordures s'ajoutent automatiquement par contre ton code n'ajoute rien en F :
Capture.PNG
Capture.PNG (8.57 Kio) Vu 49 fois
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'745
Appréciations reçues : 703
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 24 janvier 2019, 15:40

Re,
Je regarde la chose !... :oops:
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'745
Appréciations reçues : 703
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 24 janvier 2019, 16:37

Re,
A tester !... :oops:
Remontée de problèmes 2019 v1.xlsx
(16.94 Kio) Téléchargé 2 fois
Remontée de problèmes 2019 v1.xlsm
(31.5 Kio) Téléchargé 2 fois
Option Explicit

Dim lo As ListObject, lr As ListRow
Dim lCol As Long, lRow As Long
Dim dt As Date

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    Select Case Sh.Name
        Case "RdP TL1", "RdP TL2":
            Set lo = Sh.ListObjects(1)
            With lo
                If .ListRows.Count = 0 Then Exit Sub
                For Each lr In .ListRows
                    If Not IsEmpty(lr.Range.Cells(1, 1)) And IsEmpty(lr.Range.Cells(1, 10)) Then
                        lr.Range.Cells(1, 7).Resize(, 3).ClearContents
                        dt = Date
                        Select Case dt - lr.Range.Cells(1, 6)
                            Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
                            Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
                            Case Else: lr.Range.Cells(1, 9).Value = "X"
                        End Select
                    End If
                Next lr
            End With
        Case Else:
    End Select

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Select Case Sh.Name
        Case "RdP TL1", "RdP TL2"
            If Target.ListObject Is Nothing Then Exit Sub
            If Target.Count > 1 Then Exit Sub
            Set lo = Sh.ListObjects(1)
            lCol = Target.Column - lo.HeaderRowRange.Column + 1
            lRow = Target.Row - lo.HeaderRowRange.Row
            Set lr = lo.ListRows(lRow)
            Application.EnableEvents = False
            Select Case lCol
                Case 1: If Not IsEmpty(Target) Then Target.Offset(, 5).Value = Date
            End Select
            dt = Date
            lr.Range.Cells(1, 7).Resize(, 3).ClearContents
            Select Case dt - lr.Range.Cells(1, 6)
                Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
                Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
                Case Else: lr.Range.Cells(1, 9).Value = "X"
            End Select
            Application.EnableEvents = True
        Case Else:
    End Select

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Select Case Sh.Name
        Case "RdP TL1", "RdP TL2"
            If Target.ListObject Is Nothing Then Exit Sub
            If Target.Count > 1 Then Exit Sub
            Set lo = Sh.ListObjects(1)
            lCol = Target.Column - lo.HeaderRowRange.Column + 1
            Select Case lCol
                Case 10: If Not IsEmpty(Target) Then lo.HeaderRowRange.Cells(1).Select
            End Select
        Case Else:
    End Select

End Sub
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Référence circulaire
    par sisi310 » 26 juillet 2019, 13:55 » dans Excel - VBA
    1 Réponses
    38 Vues
    Dernier message par Pedro22
    26 juillet 2019, 13:55
  • Référence circulaire
    par Alias19 » 9 novembre 2015, 19:25 » dans Excel - VBA
    2 Réponses
    220 Vues
    Dernier message par Alias19
    9 novembre 2015, 21:43
  • référence circulaire
    par blobli » 16 février 2018, 15:49 » dans Excel - VBA
    4 Réponses
    177 Vues
    Dernier message par blobli
    19 février 2018, 11:45
  • Référence circulaire
    par Fat » 11 septembre 2017, 14:39 » dans Excel - VBA
    8 Réponses
    178 Vues
    Dernier message par Fat
    11 septembre 2017, 21:04
  • Référence circulaire
    par Starr » 30 mai 2015, 04:09 » dans Calc
    1 Réponses
    500 Vues
    Dernier message par James007
    30 mai 2015, 09:03
  • référence circulaire
    par Starr » 30 mai 2015, 04:13 » dans Excel - VBA
    3 Réponses
    261 Vues
    Dernier message par frangy
    30 mai 2015, 09:39