XL 2016 Aide pour collage automatique

[djuju]

Bonjour, j'ai un tableau Excel extrait de mon logiciel de restauration et je voudrais que les menus soient collés dans une autre feuille destinée à être imprimée pour affichage, comment faire pour que ce soit rapide et simple ?


merci à tous

 

[vgendron]

Hello

voici une proposition par macro

j'ai mis le menu dans le classeur "Extraction logiciel" ==> à voir si c'est possible pour toi, sinon, il faudra juste que la macro ouvre le classeur menu

si j'ai bien vu, pour chaque journée (dans le classeur extraction), il y a 11 lignes: 1 ligne date + 10 lignes de menu
==> à voir si j'ai bien réparti les 10 lignes dans le menu ==> suffit d'ajuster les indices de boule for i=...

 

[fanfan38]

Bonjour
Salut vgendron
Sans macro…
1 seul fichier
Je t'ai maudit (des dates au format standard...)
Tu n'as qu'à changer la date en A5 sur la feuille AFFICHAGE

A+ François

 

[vgendron]

Je t'ai maudit (des dates au format standard...)

Hello Fanfan

promis, pas ma faute..
quand je mets les données (sans toucher à leur format initial) dans un tablo vba (que ce soit en value ou value2),
lorsque la date est restituée.. jour et mois sont inversés...

 

[fanfan38]

Je me doute bien que c'est pas toi...
D'ailleurs j'avais ouvert les fichiers bien avant ta réponse...
Bonne journée
A+ François

 

[djuju]

Bonjour Vgendron et Fanfan, merci beaucoup pour votre retour,

Je ne suis pas sûr de mettre bien expliquer, car je ne vois pas ou ne comprends pas comment vous avez articulé la procédure.

Je voudrais pouvoir copier et imprimer en une fois plusieurs semaines d'un coup, car sur la solution de Vgendron je crois que je ne peux faire qu'une semaine.

Merci pour votre aide et vos éclaircissements.

 

[fanfan38]

Bonjour
Sur le modèle que tu as donné (menu pour édition) c'est plusieurs fois la même semaine...

A+ François

 

[vgendron]

Hello

dans la PJ, j'ai remis 7 fois le meme menu

la macro remplit le premier, les suivants sont des formules

 

[fanfan38]

Re
Toujours que la date en A5 à changer...

A+ François

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @djuju
🐌🐌🐢🐢 j'arrive à la traîne mais je te propose une version Qui te permet de choisir l'extraction logicielle à traiter (avec FIleOpenDialog)
Puis qui fait le travail :

Voir le fichier joint
À bientôt
EDIT : le code

Sub PrépaMenus()

Dim WSh As Worksheet
Application.ScreenUpdating = False
    
     With Application.FileDialog(msoFileDialogFilePicker)
          .AllowMultiSelect = False
          .Filters.Clear
          .Filters.Add "Extraction logiciel (*.xlsx, *.xls)", "*.xlsx;*.xls"
          .InitialFileName = ThisWorkbook.Path & "\"
          If .Show = -1 Then WBkPath = .SelectedItems(1) Else Exit Sub
     End With
     Set WSh = Application.Workbooks.Open(WBkPath, , True).Worksheets(1)
    
     RàZ_Menus
    
     With WSh
          Derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          tb = .Cells(1, 1).Resize(Derlgn, 5).Formula
          .Cells(1, 1).Resize(Derlgn, 5).FormulaLocal = tb
          tb = .Cells(1, 1).Resize(Derlgn, 5).Formula
     End With
     WSh.Parent.Close savechanges:=False
    
     Set Cible = Sh_Menus.Cells(5, 1).Resize(1, 5)
     NbLgn = UBound(tb, 1)
     début = 1: i = 2
     While i <= NbLgn
    
          Do While i <= NbLgn
               If (Not IsNumeric(tb(i, 1)) Or IsEmpty(tb(i, 1))) Then
                    i = i + 1
               Else
                    Exit Do
               End If
          Loop
          
          fin = i
          If fin <= NbLgn + 1 Then
               ReDim temp(1 To 16, 1 To 5)
               k = 1
               For L = début To fin - 1
                    For j = 1 To 5
                         temp(k, j) = tb(L, j)
                    Next
                    k = k + 1
                    If k = 5 Or k = 8 Or k = 11 Or k = 14 Then
                         For j = 1 To 5
                              temp(k, j) = Replace(String(9, "x"), "x", ChrW(8213))
                         Next
                         k = k + 1
                    End If
               Next
          End If
          Cible.Resize(16).Value = temp
          nbpages = nbpages + 1
          Set Cible = Cible.Offset(23)
          début = fin
          i = début + 1
     Wend
     Application.Goto Sh_Menus.Cells(1, 1)
     Application.ScreenUpdating = True
     With Sh_Menus
          .PrintOut preview:=True, from:=1, To:=nbpages
     End With
          
End Sub

Sub RàZ_Menus()
     Dim PlageRàZ As Range
     Set PlageRàZ = Sh_Menus.[A5:E23]
     For i = 1 To 7
          PlageRàZ.ClearContents
          Set PlageRàZ = PlageRàZ.Offset(23)
     Next
End Sub

 

[AtTheOne]

Re,
@vgendron ,@fanfan38
moi aussi j'ai étais confronté au problème des dates en format texte interprétées en VBA en dates mm/dd/yyyy.
j'ai solutionné ce problème en passant par FormulaLocal de la façon suivante :

...
     With WSh
          Derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          tb = .Cells(1, 1).Resize(Derlgn, 5).Formula
          .Cells(1, 1).Resize(Derlgn, 5).FormulaLocal = tb
          tb = .Cells(1, 1).Resize(Derlgn, 5).Formula
     End With
...

À bientôt