XL 2013 Tableau glissante sur plusieurs feuille macro

Jack Lethycien

XLDnaute Junior
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

XLDnaute Barbatruc
Re,

Formatez au format date que vous voulez toute la colonne.

Pour finir, plutôt que d'exclure des feuilles, il vaut mieux repérer les tableaux que vous voulez exclure.

Par exemple avec un astérisque * dans l'en-tête : Date/heure* ou Date*

Et vous utiliserez alors cette macro :
Code:
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) And Right(dat.Offset(-y), 1) <> "*" 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+
 

job75

XLDnaute Barbatruc
Re,

Non, votre problème de date vient du fait que votre version Excel est une version anglaise (ou US).

Alors utilisez cette macro qui fonctionne quelle que soit la version Excel :
Code:
Sub Tableau_AjoutH(Tableau As ListObject)
Dim y As Long, DerdateHeure As Long, h As Long, a() As Date, i As Long
With Tableau
  y = .ListRows.Count
  DerdateHeure = Int(24 * .ListRows(y).Range.Cells(1)) 
  h = 24 * Date - DerdateHeure
  If h > 0 Then
    ReDim a(1 To h, 1 To 1) 'tableau, plus rapide
    For i = 1 To UBound(a)
      a(i, 1) = (DerdateHeure + i - 1) / 24
    Next
    .ListRows(y).Range.Cells(1).Resize(h) = a 'agrandissement du tableau
  End If
End With
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Power report 05_05_2017 - essai(2).xlsm
    48.7 KB · Affichages: 37

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87