XL 2013 Tableau glissante sur plusieurs feuille macro

[Jack Lethycien]

Bonjour,

Je vous voudrais de l'aide svp. Je ne suis pas un expert en macro pour me présenter.

J'ai réçu de l'aide à créer un macro pour glissade d'un tableau (ie ajout automatique des jours sur un tableau excel) sur une feuille cela marche sans probème.

Voici le macro:
Dans module :
Sub Tableau_Ajout(Tableau As String)

Dim y As Long, objListRows As Object, derdate As Date, Jour As Integer

With ActiveSheet.ListObjects(Tableau)
y = .ListRows.Count
derdate = .ListRows(y).Range.Cells(1, 1).Value
If derdate <> Date - 1 Then
For Jour = 1 To Date - 1 - derdate
Set objListRows = .ListRows.Add
.ListRows(y + Jour).Range.Cells(1, 1).Value = derdate + Jour
Next Jour
End If
End With

End Sub

Et dans workbook
Private Sub Workbook_Open()
For Each Tableau In Worksheets("kWh").ListObjects
Call Tableau_Ajout(Tableau.Name)
Next Tableau
End Sub


Je voudrais maintenant l'exécuter sur quelques feuilles mais j'ai n'y arrive pas. Je voudrais quelqu'un m'aide svp.

Voici comment j'essaye d'écrire sur workbook mais toujours bug

Private Sub Workbook_Open()

Application.ScreenUpdating = False

Dim kWh As Worksheet
For Each kWh In Worksheets

If kWh.Name <> "kW ER1" And kWh.Name <> "kW ER2" And kWh.Name <> "kW ER3" And kWh.Name <> "Graph" And kWh.Name <> "Main Menu" And kWh.Name <> "Explanation" Then
Call Tableau_Ajout(Tableau.Name)
End If
Next

End Sub
Merci

 

[job75]

Bonjour Jack Lethycien,

Private Sub Workbook_Open()
Dim liste, kWh As Worksheet, Tableau As ListObject
Application.ScreenUpdating = False
liste = Array("kW ER1", "kW ER2", "kW ER3", "Graph", "Main Menu", "Explanation")
For Each kWh In Worksheets
  If IsError(Application.Match(kWh.Name, liste, 0)) Then
    kWh.Activate 'à cause du ActiveSheet dans la macro Tableau_Ajout...
    For Each Tableau In kWh.ListObjects
      Call Tableau_Ajout(Tableau.Name)
    Next Tableau
  End If
Next kWh
End Sub

A+

 

[job75]

Re,

Pour éviter d'activer chaque feuille :

Private Sub Workbook_Open()
Dim liste, kWh As Worksheet, Tableau As ListObject
Application.ScreenUpdating = False
liste = Array("kW ER1", "kW ER2", "kW ER3", "Graph", "Main Menu", "Explanation")
For Each kWh In Worksheets
  If IsError(Application.Match(kWh.Name, liste, 0)) Then
    For Each Tableau In kWh.ListObjects
      Call Tableau_Ajout(Tableau)
    Next Tableau
  End If
Next kWh
End Sub

Mais alors bien sûr il faut écrire :

Sub Tableau_Ajout(Tableau As ListObject)

Dim y As Long, objListRows As Object, derdate As Date, Jour As Integer

With Tableau
y = .ListRows.Count
derdate = .ListRows(y).Range.Cells(1, 1).Value
If derdate <> Date - 1 Then
For Jour = 1 To Date - 1 - derdate
Set objListRows = .ListRows.Add
.ListRows(y + Jour).Range.Cells(1, 1).Value = derdate + Jour
Next Jour
End If
End With

End Sub

A+

 

[Jack Lethycien]

Merci beaucoup Job, ça marche très très bien. Sauf que n'étant pas expert je voudrais comprendre la diiférence entre tes deux réponses.

En outre, les tableaux s'ajoutent pour les jours et c'est bien, je voudrais savoir si c'est possible que les tableau s'ajoute pour les jours et les heures.
Je m'explique pour le 1er je n'ajoute que grâce à une colonne date, on ajoute le tableau, mais si on veut ajouter les jours et les heures, 04/05/2017 (00:00 .... 23:00), 05/05/2017 (00:00 .... 23:00), etc.

Merci encore une fois

 

[job75]

Bonjour Jack Lethycien,

Sauf que n'étant pas expert je voudrais comprendre la diiférence entre tes deux réponses.

Si vous savez lire :

Pour éviter d'activer chaque feuille :
---
Mais alors bien sûr il faut écrire :

Pour la dernière question c'est à vous de bosser un peu.

A+

 

[job75]

Re,

Bon c'est vrai qu'avec les heures ce n'est pas facile.

Alors pour la 2ème solution que j'ai donnée utiliser la macro :

Sub Tableau_Ajout(Tableau As ListObject)
Dim y As Long, DerdateHeure As Date, h As Long, a() As Date, i As Long
With Tableau
  y = .ListRows.Count
  DerdateHeure = Int(24 * .ListRows(y).Range.Cells(1)) / 24
  h = 24 * (Date - DerdateHeure)
  If h > 0 Then
    ReDim a(1 To h, 1 To 1) 'tableau, plus rapide
    a(1, 1) = DerdateHeure
    For i = 2 To UBound(a)
      a(i, 1) = Format(a(i - 1, 1) + 1 / 24, "dd/mm/yyyy hh:mm")
    Next
    .ListRows(y).Range.Cells(1).Resize(h) = a 'agrandissement du tableau
  End If
End With
End Sub

A+

 

[Jack Lethycien]

Bonjour Job,

Merci pour ton aide, j'ai essayé le dernier macro comme tu di c'est trop compliqué pour moi, au moment de l'exécution je récois le msg bug sur la ligne de code

Call Tableau_Ajout(Tableau.Name)

J'essaie d'analyse de mon côté. VOtre aide est toujours importante pour moi.

 

[job75]

Bonjour Jack Lethycien,

Vous n'avez toujours pas compris la différence entre les 2 solutions que j'ai données !!!

Comme je l'ai dit la macro du post #6 c'est pour la 2ème solution donc il faut l'appeler par :

Call Tableau_Ajout(Tableau)

Bonne journée.

 

[job75]

Re,

Pour finir, un petit complément en dernière ligne de la Workbook_Open (2ème solution) :

Private Sub Workbook_Open()
Dim liste, kWh As Worksheet, Tableau As ListObject
Application.ScreenUpdating = False
liste = Array("kW ER1", "kW ER2", "kW ER3", "Graph", "Main Menu", "Explanation")
For Each kWh In Worksheets
  If IsError(Application.Match(kWh.Name, liste, 0)) Then
    For Each Tableau In kWh.ListObjects
      Call Tableau_Ajout(Tableau)
    Next Tableau
  End If
Next kWh
Me.Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

Enfin dans la macro Tableau_Ajout vous vous demandez peut-être pourquoi j'écris :

DerdateHeure = Int(24 * .ListRows(y).Range.Cells(1)) / 24

Au cas où l'on mettrait des minutes dans la dernière ligne du tableau ce code les remplace par 0.

A+

 

[Jack Lethycien]

Merci beaucoup, j'ai attaché le fichier en attache. Je n'y arrive pas. Je suis peut être un mauvais élève. Votre help please.

 

[job75]

Re,

Je suis peut être un mauvais élève.

Oui, et d'abord vous ne lisez pas les posts que j'envoie.

Ensuite pourquoi joindre un fichier .xls alors que les tableaux Excel ne fonctionnent vraiment qu'à partir d'Excel 2007 ?

Enfin si vous voulez que la 3ème feuille soit traitée il faut la nommer "kWh ER1" et pas "kW ER1" qui est une feuille exclue.

Ci-joint votre fichier complété avec des tableaux Excel et enregistré en .xlsm.

A+

 

[Jack Lethycien]

Mr Job, sorry. Je lis tout mais c'est difficille de comprendre en un seul coup. Tu es génie merci pour ton aide. Be blessed.

Si tu peux m'aider avec des cours ou livres peut être

 

[Jack Lethycien]

Thanks again, je vous remercie vraiment pour le temps concentré pour moi

 

[Jack Lethycien]

Salut Job, sorry de venir encore pour mon soucis.

En effet, j'ai essayé de combiner les deux macro en 1 pour executer différents page dans mon fichier mais j'ai un message d'erreur.

En effet, je souhaiterais que les feuilles qui n'ont que des jours executent le premier macro pour les jours que m'avais aidé et les feuilles ayant des jours et heures exécutent le second macro.

En attache mon essai

Merci beaucoup

 

[job75]

Bonjour Jack Lethycien,

Votre fichier en retour.

Dans la Workbook_Open j'ai viré les 2 listes des feuilles à exclure.

Elles n'étaient pas bien claires et à mon avis inutiles.

Il suffit de tester si la dernière ligne de chaque tableau contient bien une date en 1ère colonne.

Le type d'incrémentation (jour ou heure) est déterminé par le format de cette date :

Private Sub Workbook_Open()
Dim w As Worksheet, Tableau As ListObject, y As Long, dat As Range
Application.ScreenUpdating = False
For Each w In Worksheets
  For Each Tableau In w.ListObjects
    y = Tableau.ListRows.Count
    Set dat = Tableau.ListRows(y).Range.Cells(1)
    If IsDate(dat) Then
      If dat.NumberFormat Like "*h:m*" Then Call Tableau_AjoutH(Tableau) Else Call Tableau_Ajout(Tableau)
    End If
Next Tableau, w
End Sub

A+