XL 2010 Zone d'impression + Ordre Alpha

[crowysterik]

Bonjour,
grace à l'aide d'un des utilisateurs de ce forum,
j'ai pu créer ce fichier qui marche impeccable,
J'explique
j'importe des données d'un logiciel de gestion des temps et la maccro définit les zones d'impression et imprime une feuille d'heure par salarié

Pourriez-vous m'aider à créer une maccro afin qu'avant l'impression, on puisse mettre par ordre alphabétique les feuilles

le nom prénom se trouve en colonne C

il faudrait donc définir la zone d'impression jusqu'au prochain matricule, mettre par ordre alphabétique et ensuite imprimer ou créer un bouton impression à part.

Vous pensez que c'est réalisable ?

ça me ferait gagner énormement de temps,

Je vous remercie bcp,
Fabien

 

[Rhysand]

Bonsoir à tous

J'ai dû changer tout votre code, car il y avait beaucoup d'erreurs et la sélection de la zone à imprimer n'était pas correcte

pour imprimer il suffit de changer cette partie dans le code

        'ActiveSheet.PrintOut

        ActiveSheet.PrintPreview

copiez le code suivant dans votre module

Option Explicit

Public Sub zone_imp()

Dim rng As Range, range1 As Range
Dim iniR As Integer, endR As Integer
Dim i As Integer, a As Integer, e As Integer, x As Integer
Dim ArrInput() As String
Dim ArrOutput As Variant
Dim xprint As String
Dim lastrow As Integer
Dim zone As String
Dim myCmPointsBase As Single

myCmPointsBase = Application.CentimetersToPoints(0.5)

i = 0

On Error Resume Next
ReDim ArrInput(0)
On Error GoTo 0

With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set range1 = .Range("A10" & ":" & "A" & lastrow)
    For Each rng In range1
            If rng.Value = "Matricule :" Then
                zone = ""
                iniR = rng.Cells.Row
                For a = iniR To lastrow
                    If .Range("A" & a).Value = "" Then
                        endR = .Range("A" & a).Cells.Row
                        Exit For
                    End If
                Next a
                If endR < iniR Then endR = lastrow
                zone = "A" & iniR & ":M" & endR
                ArrInput(i) = Range("B" & iniR) & "#" & zone
                i = i + 1
                ReDim Preserve ArrInput(i)
            End If
    Next rng
End With

If i > 0 Then
    ArrInput = SortMyArray(ArrInput)
    For x = LBound(ArrInput) To UBound(ArrInput)
        ArrOutput = Split((ArrInput(x)), "#")
        On Error Resume Next
        xprint = ArrOutput(1)
        On Error GoTo 0
        If xprint <> "" Then
        With ActiveSheet
            With .PageSetup
                .PrintArea = xprint ' print area
                .PaperSize = xlPaperA4
                .Orientation = xlPortrait
                .Zoom = False
                .FitToPagesTall = False
                .FitToPagesWide = 1
                .PrintGridlines = False
                .PrintHeadings = False
    '            .PrintTitleRows = .Rows(1).Address
    '            .PrintQuality = -3 ' ATTENTION  - dépend de chaque PC et imprimante
                .FooterMargin = myCmPointsBase * 2
                .HeaderMargin = myCmPointsBase * 2
                .AlignMarginsHeaderFooter = True
                .TopMargin = myCmPointsBase * 5
                .RightMargin = myCmPointsBase * 3
                .BottomMargin = myCmPointsBase * 5
                .LeftMargin = myCmPointsBase * 3
                .CenterHorizontally = True
                .CenterVertically = False
    '            .CenterFooter = "&Iinsérer du texte ici"
    '            .RightFooter = "Pag. &P de &N"
    ''            .CenterHeader = "&G"
    '            .CenterHeader = "&D" & " - " & "&T" '
    '            With .CenterHeaderPicture
    ''                .FileName = "C:\...\mypic.jpg"
    ''                .ColorType = msoPictureAutomatic
    ''                .LockAspectRatio = msoTrue
    ''                .Height = myCmPointsBase * 2
    '            End With
    '            .OddAndEvenPagesHeaderFooter = True
    '                With .EvenPage
    '                    .CenterFooter.Text = "&Binsérer du texte ici"
    '                    .RightFooter.Text = "Pag &P de &N"
    '                    With .CenterHeader
    ''                        .Text = "&G"
    '                        .Text = "insérer du texte ici"
    '                        With .Picture
    ''                            .FileName = "C:\...\mypic.jpg"
    ''                            .ColorType = msoPictureAutomatic
    ''                            .LockAspectRatio = msoTrue
    ''                            .Height = myCmPointsBase * 2
    '                        End With
    '                    End With
    '                     .RightHeader.Text = "insérer du texte ici"
            End With
        End With
        'ActiveSheet.PrintOut
        ActiveSheet.PrintPreview
         End If
    Next x
End If


If Not range1 Is Nothing Then Set range1 = Nothing

End Sub

Private Function SortMyArray(myArray As Variant) 'Dans l 'ordre croissant

Dim i As Long
Dim j As Long
Dim Temp

For i = LBound(myArray) To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortMyArray = myArray

End Function

 

[crowysterik]

Bonjour,
je vous remercie pour votre aide,
mais après fait plusieurs tests, cela ne fonctionne pas, j'ai essayé de copier coller votre code uniquement et rien ne fonctionne,
je ne suis pas assez à l'aise pour trouver l'erreur, je suis sous excel 2010.

merci pour votre aide,

 

[Rhysand]

Bonjour à tous

faire ce changement de code:

changer : If rng.Value = "Matricule :" Then pour ==> If rng.Text = "Matricule :" Then

J'ai fait des tests 32 bits et 64 bits, cela a parfaitement fonctionné

 

[crowysterik]

Bonjour,

Ok je vous fais confiance mais chez moi, quand j'active la maccro, rien ne se passe (pas de message d'erreur non plus)
Ma demande est bien que chaque feuille soit mise en ordre alphabétique, c'est à dire que les noms en colonne C se mettent dans l'ordre croissant jusqu'à la prochaine zone d'impression,

peut être que ma demande n'est pas claire aussi

avez vous la possibilité de me donner le fichier sur lequel vous avez travaillé pour exemple svp ?

 

[Rhysand]

bonjour à tous

fichier de démonstration joint

Je viens de tester sur 3 ordinateurs différents, avec excel 2013 pro 32-bits, avec excel 2016 32-bits et avec excel 2019 pro 64-bits


la macro est définie sur "PrintPreview ", pour imprimer modifier cette partie

 

[crowysterik]

Bonsoir à tous,
Effectivement la maccro fonctionne à présent
par contre, l'ordre croissant ne fonctionne pas sur la bonne case.
Ce sont les noms qui sont en colonne C qui doivent être imprimés en ordre croissant

Exemple ligne 10

Matricule :

5339

DUPONT X

et ligne 159

Matricule :

5441

ATEST DUPONT

c'est bien la colonne C (attest DUPONT) qui doit être imprimé en premier

l'ordre croissant dans votre fichier se fait sur le N° de matricule donc la colonne B.

Est-ce plus simple de faire deux maccros différentes ?

Une première qui mets les noms par ordre croissant jusqu'au prochain nom ou prochain ligne matricule :

et une deuxième pour définir la zone d'impression et imprimer ?

Merci par avance,

 

[Rhysand]

Bon après-midi à tous,

Je suis désolé, c'était mon erreur, et je ne l'ai même pas corrigée avec vos avertissements, je me suis concentré sur la colonne ("B") avec les chiffres

changez simplement cette partie du code et il triera par noms

'                ArrInput(i) = Range("B" & iniR) & "#" & zone ' numéro
                ArrInput(i) = Range("C" & iniR) & "#" & zone ' nom

 

[crowysterik]

Merci beaucoup, ça fonctionne parfaitement,