Boucle sur feuilles au format date "dd mm yy" à modifier

cibleo · 15 Novembre 2009

Bonjour le forum,

Le code placé dans le formulaire "Synthese" (Private Sub CommandButton1_Click())fonctionne et me permet d'effectuer une recherche dans toutes les feuilles (au format date) à partir d'un nom sélectionné dans la ComboChauffeurs.

Le report s'effectue alors dans la feuille de calcul "Synthese".

Dans ce formulaire, je dois donc opérer 2 choix :

- le nom du chauffeur (ça marche)
- le mois qui doit me permettre de sélectionner les feuilles de calcul à traiter (je demande votre aide, je ne sais pas faire)

Dans 1 premier temps, j'aimerais donc reporter les noms des feuilles (des dates) que je vais traiter : dans la colonne A à partir de A2 Feuille de calcul "Synthese".

Puis j'aimerais pouvoir sélectionner ,à l'aide de la ComboMois, les feuilles à traiter.

Exemple : je choisis 01 et ce sont toutes les feuilles de mon classeur nommées 01 01 09, 02 01 09, 05 01 09 etc... qui devront être traiter.

Idem pour les autres mois.

Dans le code présenté, toutes les feuilles sont traitées, pouvez-vous m'aider à modifier ce code ?

Code:

.../...
For Each Ws In ThisWorkbook.Worksheets
    With Ws
    If IsDate(Ws.Name) Then
.../...

Cibleo

jp14 · 15 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

ci dessous un code

Code:

For Each Ws In ThisWorkbook.Worksheets
    With Ws
    If InStr(3, Ws.Name, " " & ComboMois.Value & " ") > 0 Then
      'If YesFormatDate_ddmmyy(Sh.Name) Then
      'If Left(.Name, 6) = "Caisse" Then
    Set plage = .Range("A4:A11")
' a supprimer après essai
    Call MsgBox("mois trouvé " & ComboMois.Value _
                & vbCrLf & "dans feuille " & Ws.Name _
                , vbExclamation, Application.Name)
    
    With plage

a tester

JP

cibleo · 16 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir à tous,
Bonsoir jp14,

Merci jp14, le deuxième point est résolu

J'aimerais maintenant revenir à ma première question à savoir inscrire (au format "jjj jj mmm aa") le nom des feuilles traitées dans la colonne A à partir de A2.

J'ai mis l'instruction ci-dessous mais cela commence à A1 (dans la ligne d'en-têtes) au lieu de A2

Où dois-je la placer exactement dans le code ?

Code:

Sheets("Synthese").Cells(DerLiR, 1) = Ws.Name

En plus, j'aimerais gommer les imperfections dans le Private Sub UserForm_Initialize().

En effet, la ligne d'en-têtes s'efface quand j'exécute le code une 2ème fois.

Pourtant, j'ai écrit ceci :

Code:

ShtR.Range("[B][COLOR=red]A2[/COLOR][/B]:Q" & DerLiR).ClearContents

Idem pour les autres instructions.

Je dois avoir un souci avec la variable DerLiR

Encore merci Cibleo

Ps : la cellule A262 n'est pas vide au départ.

jp14 · 16 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir

Le code ci dessous permet de trouver la dernière ligne écrite

Code:

DerLiR = Sheets("Synthese").Range("a65536").End(xlUp).Row

Pour connaitre la ligne ou l'on doit écrire on ajoute 1

Code:

DerLiR = Sheets("Synthese").Range("a65536").End(xlUp).Row +1

A tester

JP

cibleo · 17 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour à tous,
Bonjour jp14,

J'ai suivi tes conseils mais y a un truc que je n'arrive pas à résoudre

Pourtant, cela doit être simple.

Démonstration : feuille "Synthèse", je clique sur le bouton rouge : les lignes 2, 3 et 4 s'effacent ----> normal

Puis je sélectionne le Mois 4 et un chauffeur ---> Message : Pas de trace ---> normal (pas de feuilles en avril) ----> puis OK

Et là, je reclique sur le bouton rouge et ma ligne 1 (les en-têtes) s'efface

Je ne comprends pas

Sinon le format date "ddd dd mmm yy" se traduit comme ceci avec 1 point : lun. 02 févr 09 Bizarre non !

Je reviens ce soir avec d'autres question, en attendant bonne après midi à tous.

Cibleo

jp14 · 17 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour cibleo, le forum

Derlir contient la dernière ligne utilisée.
Le code suivant efface de la ligne 2 à la ligne "Derlir"
ShtR.Range("A2:Q" & DerLiR).ClearContents

Si derlir = 1 on efface la ligne 2 et la ligne 1.

Il faut donc écrire le code suivant pour éviter ce problème
DerLiR = Sheets("Synthese").Range("a65536").End(xlUp).Row
If DerLiR = 1 Then DerLiR = 2

A tester

JP

cibleo · 17 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Re à tous et Jp14,

C'est tout bon

Ci-dessus, j'ai remplacé le fichier avec les modifs.

Comme vous le voyez, ce tableau est dynamique et j'aimerais soigner la mise en forme en appliquant des bordures.

J'ai donc intégré la partie en vert dans le Do Loop en m'inspirant d'un autre code que j'ai placé dans le module de la feuille "Synthèse".
Mais çà ne marche pas

Plus bas, le code fonctionne mais ne s'applique qu'à une plage figée, comment puis-je l'appliquer à ma plage dynamique ?

Dois-je le placer dans le Do Loop ou après ?

Code:

.../...
With plage
      Set Cel = .Find(VSearch, LookAt:=xlPart)
      If Not Cel Is Nothing Then
      trouve = True
          Adrdeb = Cel.Address
          [COLOR=blue]Do[/COLOR]
            DerLiR = DerLiR + 1
            Range(Ws.Cells(Cel.Row, 2), Ws.Cells(Cel.Row, 12)).Copy ShtR.Cells(DerLiR, 4)
            ShtR.Cells(DerLiR, 1) = Format(Ws.Name, "ddd dd mmm yy")
 
           [COLOR=darkgreen]'With Range(ShtR.Cells(DerLiR, 1), ShtR.Cells(DerLiR, 18))[/COLOR]
[COLOR=darkgreen]'.BorderAround 1, xlThin[/COLOR]
[COLOR=darkgreen]'.Borders(xlInsideHorizontal).LineStyle = xlContinuous[/COLOR]
[COLOR=darkgreen]'.Borders(xlInsideHorizontal).Weight = xlThin[/COLOR]
[COLOR=darkgreen]'.Borders(xlInsideVertical).LineStyle = xlContinuous[/COLOR]
[COLOR=darkgreen]'.Borders(xlInsideVertical).Weight = xlHairline[/COLOR]
[COLOR=darkgreen]'End With[/COLOR]
 
              Set Cel = .FindNext(Cel)
          [COLOR=blue]Loop While[/COLOR] Not Cel Is Nothing And Adrdeb <> Cel.Address
      End If
.../...

Code:

Sub QUADRILLER()
Dim Champ As Range
Set Champ = Range("A2:R20")
Application.ScreenUpdating = False
With Champ
.BorderAround 1, xlThin
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlHairline
End With
End Sub

Cibleo

cibleo · 19 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour à tous,
Bonjour JP14,

Je reviens pour trouver une variante de la ligne en rouge.

Pour cela, j'ai placé dans le formulaire une ListBox1 (Début) et Listbox2 (Fin) qui doivent me permettre de sélectionner le début et la fin des feuilles à traiter.

Code:

For Each Ws In ThisWorkbook.Worksheets
    With Ws
    [COLOR=red]If InStr(3, Ws.Name, " " & ComboMois.Value & " ") > 0 Then[/COLOR]
[B][COLOR=darkgreen]'Instruction associée à la ComboMois[/COLOR][/B]

Comment dois-je modifier la ligne en rouge ?

Pouvez-vous de nouveau me venir en aide ?

Cibleo

jp14 · 19 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

cibleo à dit:
Re à tous et Jp14,

C'est tout bon

Ci-dessus, j'ai remplacé le fichier avec les modifs.

Comme vous le voyez, ce tableau est dynamique et j'aimerais soigner la mise en forme en appliquant des bordures.

J'ai donc intégré la partie en vert dans le Do Loop en m'inspirant d'un autre code que j'ai placé dans le module de la feuille "Synthèse".
Mais çà ne marche pas

Plus bas, le code fonctionne mais ne s'applique qu'à une plage figée, comment puis-je l'appliquer à ma plage dynamique ?

Dois-je le placer dans le Do Loop ou après ?

Cibleo

Il faut mettre après la boucle do

Code:

  Next Ws
With Sheets("Synthese")
DerLiR = .Range("a65536").End(xlUp).Row + 1
If trouve = False Then MsgBox "Pas de trace !"
With .Range(Cells(2, 1), Cells(DerLiR, 18))
    .BorderAround 1, xlThin
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlThin
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideVertical).Weight = xlHairline
End With
End With

  
  
    Range("A2").Select

    ActiveWindow.DisplayZeros = False

    Application.EnableEvents = True

    Application.ScreenUpdating = True
    Unload Me

A tester

JP

jp14 · 19 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir

cibleo à dit:
Bonjour à tous,
Bonjour JP14,

Je reviens pour trouver une variante de la ligne en rouge.

Pour cela, j'ai placé dans le formulaire une ListBox1 (Début) et Listbox2 (Fin) qui doivent me permettre de sélectionner le début et la fin des feuilles à traiter.

Cibleo

Le plus simple serait d'utiliser une listbox avec une sélection multiple.
Il suffirait de mettre l'ancien code dans la boucle de test des éléments de la listbox.

Un exemple ci joint

JP

cibleo · 20 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonsoir à tous,
Bonsoir JP14,

Tu dis :

Le plus simple serait d'utiliser une listbox avec une sélection multiple.

Je suis bien d'accord avec toi, mais je n'ai rien pigé à ton dernier fichier joint

Je continue de tester ta solution pour les bordures mais le résultat escompté n'est pas tout à fait obtenu.

A+ Cibleo

jp14 · 21 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour

Ci joint le fichier avec une listbox avec affichage des dates triées.
L'opérateur doit sélectionner la date de début et la date de fin, cette sélection peut se faire dans le désordre, il ne peut en choisir que deux dates.
Lors de ce choix, les contrôles non utiles son masqués.

Pour trouver le nombre d'éléments sélectionnés j'utilise l'évènement :
Private Sub ListBox1_Mouseup(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single).

L'évènement Private Sub ListBox1_Click() ne fonctionne pas dans ce cas de figure.

J'ai modifié la commande "recherche" pour l'adapter au deux méthode.

A tester
Bon week end

JP

cibleo · 22 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bonjour à tous,
Bonjour JP14

Je découvre ton remarquable travail, faut vraiment s'accrocher

C'est exactement ce que je souhaitais : choisir un mois ou un intervalle de 2 dates.

Tes codes sont si bien structurés que j'arrive à trouver où cela peut clocher même si je n'en comprends pas forcément la syntaxe.

Après tests, je reviens donc sur 3 points.

La syntaxe de la ligne surlignée en rouge ci-dessous.
Mes données ne sont plus copiées dans la feuille "Synthese" comme précédemment.

Code:

Private Sub remplirsynthese(£nomfeuille As Variant, VSearch As String)
Dim plage As Range, Cel As Range, Adrdeb As String
With Sheets(£nomfeuille)
    Set plage = .Range("A4:A11")
    .../...          
         Do
            DerLiR = DerLiR + 1
            [B][COLOR=red]Range(Cells(Cel.Row, 2), Cells(Cel.Row, 12)).Copy ShtR.Cells(DerLiR, 2)[/COLOR][/B]
            ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "ddd dd mmm yy")
            Set Cel = .FindNext(Cel)
          Loop While Not Cel Is Nothing And Adrdeb <> Cel.Address
      End If
     End With
     End With
End Sub

Dans la listbox1, le premier item est blanc, c'est celui de la première feuille de mon classeur si j'ai bien compris (feuille "Synthese")

Comment le faire disparaître ?

Dernier point :

Comme illustrer ci dessus, je sélectionne les 2 Items soit la feuille de début et celle de fin.

L'item du début fonctionne, par contre la fin est toujours le dernier item de la Listbox1 soit le 03 03 09 dans mon exemple alors que j'ai sélectionné 04 02 09.

Peux-tu rectifier le tir ?

Je continue à tester et reviens pour les colonnes Q et S dans lesquelles je dois implanter des formules automatiquement.

Je pense avoir trouvé matière pour travailler

A+ Cibleo

jp14 · 22 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Bon jour

Pour supprimer la ligne blanche il faut modifier dans la procédure
Sub UserForm_Initialize()

Code:

For £i = 1 To UBound(table, 2)
    [COLOR="Red"]If table(£i, 1) <> "" Then[/COLOR]
        .AddItem table(£i, 1)
        .List(.ListCount - 1, .ColumnCount - 1) = table(£i, 2)
    [COLOR="Red"]End If[/COLOR]
Next £i

Concernant l'erreur sur le code
Range(Cells(Cel.Row, 2), Cells(Cel.Row, 12)).Copy ShtR.Cells(...
il faut que la macro soit lancé de la feuille synthèse.

Ci dessous le code à corriger pour éviter de parcourir toute la liste.

Code:

If ListBox1.Selected(i) = True And premier = True Then
        premier = False
        dernier = True
    End If
    
    If ListBox1.Selected(i) = True And premier = False [COLOR="Red"]And dernier = False[/COLOR] Then premier = True
    
        
    If premier = True Or dernier = True Then
        MsgBox ListBox1.List(i)
        Call remplirsynthese(ListBox1.List(i), VSearch)
        dernier = False
    End If

A tester

JP

cibleo · 22 Novembre 2009

Re : Boucle sur feuilles au format date "dd mm yy" à modifier

Re JP14,

J'ai remplacé le fichier ci-dessus avec tes modifications.
C'est GÉNIAL

Mais le problème persiste au niveau de la copie des données.
Je ne comprends pas ou j'ai mal saisi ce que tu me dis

Concernant l'erreur sur le code
Range(Cells(Cel.Row, 2), Cells(Cel.Row, 12)).Copy ShtR.Cells(...
il faut que la macro soit lancé de la feuille synthèse.

Laisse moi le temps de souffler.

A+ Cibleo

Boucle sur feuilles au format date "dd mm yy" à modifier

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Partager cette page

Statistiques des forums