XL 2010 code vba pour imprimer le nbr de pages indiquées d'onglets sélectionnés

[sebbbbb]

Bonsoir a toutes et tous

je bute sur un problème que j'aimerai vous soumettre.

Dans le 1er onglet du fichier en pJ se trouve un petit tableau pour indiquer quel onglet (sur les 5 au total) sera imprimé et le nbr de copie de chacun

un bouton devra pouvoir lancer l'impression

le top du top serait de lancer l'impression en mode 'copies NON assemblées

Pouvez vous m'aider svp ?

un grand merci par avance
seb

 

[kiki29]

Salut, shBL est le CodeName attribué à la feuille "BL Mobile1", à toi de tester, adapter à ton contexte.

Option Explicit

Sub Impression()
Dim i As Long, j As Long, Nb As Long
Dim Wsh As Worksheet, Ar() As String

    Application.ScreenUpdating = False
    Erase Ar
    For Each Wsh In ThisWorkbook.Worksheets
        ReDim Preserve Ar(i)
        Ar(i) = Wsh.Name
        i = i + 1
    Next Wsh

    j = 11
    For i = LBound(Ar) To UBound(Ar)
        Set Wsh = Worksheets(Ar(i))
        If shBL.Range("BS" & j) = Ar(i) Then
            Nb = shBL.Range("CD" & j)
            If Nb > 0 Then Wsh.PrintOut copies:=Nb ', Collate := False
            j = j + 1
        End If
    Next i

    shBL.Select
    Application.ScreenUpdating = True
End Sub

A lire : Sheets. PrintOut, méthode (Excel)

 

[sebbbbb]

bonjour et merci pour ton aide
comment puis je attribuer le code name shBL à ma feuille BL Mobile1
je l'ai fait une fois mais je n'arrive plus a me rappeler la procédure
merci a toi
seb

 

[sebbbbb]

Ok j'ai trouvé
je fais les tests et te redis
merci infiniment
seb

 

[sebbbbb]

bonjour kiki29
j'ai inséré le code dans mon fichier source (celui communiqué n'était qu'une partie), et j'ai un problème
serait ce parce que j'ai d'autres onglets qui s'affichent en même temps ? a noter j'ai également une multitude d'autres onglets qui sont cachés.
si le prob vient de là est il possible de sélectionner seulement les onglets listés (ou on affiche le nbr de copies a imprimer)
merci par avance
seb

 

[kiki29]

Re, ici qq soit le nb de feuilles insérées, en plus des feuilles existantes, cela fonctionne sans aucun pb.

 

[sebbbbb]

voici le code erreur que j'ai

lorsque je clique sur débogage voici ce qui apparait en jaune

For Each Wsh In ThisWorkbook.Worksheets

merci pour ton aide
seb

 

[kiki29]

Re, je ne pratique pas l'extispicine ...

 

[sebbbbb]

Je suis alors en mauvaise posture

 

[sebbbbb]

j'ai pourtant tout écrit comme tu le mentionnais

ci dessous ecran

 

[sebbbbb]

J'utilise excel 2007. pourait ce etre un prob de version ?
merci

 

[sebbbbb]

EUREKA !
Je ne pratique pas l' extispicine non plus, mais j'ai trouvé le bug.
je ne sais pour quel raison j'ai 2 workbook. une qui s'appelle workbook et qui ne contient rien et le second workbook1 qui contient toutes les formules. Il suffisait donc que j'ajoute le 1.
Merci infiniment kiki29
seb

 

[sebbbbb]

Bonjour Kiki29, bonjour a tous

je me permets de te relancer car je me sens un peu frustré. Ton scrip fonctionne parfaitement bien mais j'aimerai le faire évoluer

en effet j'ai un fichier sur lequel j'ai enfin réussi a faire ce que je souhaitais c'est à dire, lorsque je clique sur le bouton NEW, les 5 onglets verts sont démultipliés et apparaissent avec un nom chronologique

Je souhaiterai intégré ton scrip pour que celui ci soit également opérationnel sur les nouveaux onglets créés

j'ajoute que le fichier joint est seulement un morceau du fichier mère qui lui comporte bcp plus d'onglets dont bcp sont cachés.

peut etre faut il que je fasse une autre discussion mais c'est tout de même un peu lié

merci a tous ceux qui voudront bien m'aider
seb

 

[kiki29]

Re, la procédure Impression modifiée, à toi de tester

Option Explicit

Sub Impression()
Dim i As Long, j As Long, Nb As Long, NbD As Long
Dim Wsh As Worksheet, WshAct As Worksheet, s As String, Ar() As String

    Application.ScreenUpdating = False
    Erase Ar
    For Each Wsh In ThisWorkbook.Worksheets
        ReDim Preserve Ar(i)
        If Wsh.Visible = -1 Then
            Ar(i) = Wsh.Name
            i = i + 1
        End If
    Next Wsh

    s = ActiveSheet.Name
    If InStr(s, "BL Mobile") > 0 Then
        Set WshAct = Worksheets(s)
        For i = 11 To 15
            NbD = NbCh(WshAct.Range("BS" & i))
            s = Left$(WshAct.Range("BS" & i), NbD)
            WshAct.Range("BS" & i) = s & WshAct.Range("BM3")
        Next i

        j = 11
        For i = LBound(Ar) To UBound(Ar)
            Set Wsh = Worksheets(Ar(i))
            If WshAct.Range("BS" & j) = Ar(i) Then
                Nb = WshAct.Range("CD" & j)
                If Nb > 0 Then Wsh.PrintOut copies:=Nb ', Collate:=False
                j = j + 1
            End If
        Next i
        WshAct.Select
    Else
        MsgBox "Sélectionnez une feuille BL Mobile" & vbCrLf & "Puis cliquez sur le bouton Impression", vbOKOnly + vbInformation
    End If
    Application.ScreenUpdating = True
End Sub

Private Function NbCh(s As String) As Long
Dim i As Long, Ch As String
    For i = 1 To Len(s)
        Ch = Mid$(s, i, 1)
        If Asc(Ch) >= 48 And Asc(Ch) <= 57 Then Exit For
    Next i
    NbCh = i - 1
End Function

 

[sebbbbb]

BOnsoir Kiki29
You are the BEST !!!
il faut je fasse les tests avec l'imprimante mais aucun bug pour le moment
merci infiniment pour ton aide
seb
PS : je te redis des que j'ai testé