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, une version "Tout auto", à tester ...

 

[sebbbbb]

Bonjour
excellent !
si tu devances même mes besoins, c'est parfait
merci infiniment

 

[kiki29]

Salut, désolé, mais comme je dis également : pas de bras, pas de chocolat ...

 

[sebbbbb]

Bon je vais essayer reduire le fichier alors
Merci

 

[sebbbbb]

suis trop déçu
trop compliqué de reduire mon fichier
c'est vraiment bête tout ce boulot pour échouer maintenant :-(
suis sur que c'est un tout petit rien a corriger en plus.
les ecrans ne te donnent aucune indication ou celà pourrait pêcher ?
sinon tant pis. merci infiniment pour ton aide

 

[kiki29]

Re, même zippé sa taille > 2 Mo ?

 

[soan]

Bonjour seb, kiki29,

@kiki29

J'ai repris ton code VBA, inclus dans ton fichier .zip du post #16.

J'aime bien tes variables I, II, III, IV, V ; mais tu as oublié
Henri VI, Henri VII, Henri VIII ! pour la petite histoire,
Charles Perrault s'est inspiré d'Henri VIII pour son conte
« La Barbe bleue ».

------------------------------------------------------------------------

@sebbbbb

Tu as des feuilles "BL Mobile", "Man Mobile", "PL Mobile",
mais je n'ai pas vu tes feuilles "Playmobil" !

IMPORTANT : Avant de voir le code VBA, vérifie si tout
fonctionne bien comme tu veux : clique sur ton bouton
rouge, et sur ton bouton noir.

J'ai fait plein de modifs dans le code VBA du fichier .xlsb ;
j'ai modifié les modules mImpression et mNew ; et aussi
le code des feuilles shBL1, shPL1, shSWB1.

Tu vas avoir du boulot pour tout lire !!! c'est normal :
avec un bouton rouge et un bouton noir, je ne pouvais
pas faire autrement que de te concocter un code VBA
aussi long que « Le Rouge et le Noir », de Stendhal !

ATTENTION : J'ai bien vérifié : ça marche correctement
sur mon PC ; sur ton PC, le fichier joint devrait aussi
marcher correctement ; cependant, avec ton fichier réel,
je pense que la sub Impression() va planter, même si tu
transpose le code VBA correctement ; à cause de ceci :

Je ne sais pas ce que tu as fait pour avoir un ThisWorkbook1
en plus de ThisWorkbook, mais d'une façon ou d'une autre,
il faut vraiment que tu arranges ça !!!

À te lire pour avoir ton avis ; si tu as besoin d'une adaptation,
n'hésite pas à demander.

soan

 

[sebbbbb]

Merci Soan
je vais regarder celà a tête reposé mais le code de kiki fonctionnait bien...sauf quand je l'adaptais a mon fichier
je sais que workbook1 n'est pas normal mais je m'en accomode en modif les scripts

@kiki29
c est quoi la limite pour envoyer un fichier ? mon fichier zip 1900 ko ne passe pas

merci a vous
seb

 

[soan]

@sebbbbb

Quand j'ai écrit que le code VBA est très long,
c'était pour les 5 modules confondus !

Code VBA de mImpression (32 lignes) :

Option Explicit

Sub Impression()
  Dim Wsh As Worksheet, WshAct As Worksheet
  Dim Ar() As String, s$, Nb&, I&, j&

  Erase Ar: Application.ScreenUpdating = 0
  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): j = 11
    For I = 0 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.", 64
  End If
End Sub

Code VBA de mNew (57 lignes) :

Option Explicit

Dim FX$

Private Sub Rpl()
  ActiveSheet.UsedRange.Replace What:="BL Mobile1", Replacement:=FX, LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Sub NEWblmobile()
  Const fmt As String * 7 = "0"" kgs"""
  Dim Ws As Worksheet, I&, II&, III&, IV&, V&
  Application.ScreenUpdating = 0
  With ActiveWorkbook
    For Each Ws In .Worksheets
      FX = Ws.Name
      Select Case -1
        Case FX Like "BL Mobile*": I = I + 1
        Case FX Like "PL Mobile*": II = II + 1
        Case FX Like "Man Mobile*": III = III + 1
        Case FX Like "Receipt*": IV = IV + 1
        Case FX Like "SWB service*": V = V + 1
      End Select
    Next Ws
    Application.EnableEvents = 0

    .Worksheets("BL Mobile1").Copy after:=.Sheets(.Sheets.Count)
    [C30:AV52] = "": [C30:AV52].HorizontalAlignment = xlLeft
    [AX30:BF52] = "": [AX30:BF52].Activate: Selection.NumberFormat = fmt
    FX = "BL Mobile" & 1 + I: ActiveSheet.Name = FX: [BS11] = FX
    [BS12] = "PL Mobile" & II + 1: [BS13] = "Man Mobile" & III + 1
    [BS14] = "Receipt" & IV + 1: [BS15] = "SWB service" & V + 1
    [BM3] = 1 + I: [BM3].Select

    .Worksheets("PL Mobile1").Copy after:=.Sheets(.Sheets.Count)
    ActiveSheet.Name = "PL Mobile" & 1 + II: [A9:E42] = ""
    [D9:E43].Activate: Selection.NumberFormat = fmt: Rpl

    .Worksheets("Man Mobile1").Copy after:=.Sheets(.Sheets.Count)
    With ActiveSheet
      .Name = "Man Mobile" & 1 + III: .Unprotect
      [D17:G18].HorizontalAlignment = xlLeft: [H15:H38].Activate
      Selection.NumberFormat = fmt: Rpl: .Protect
    End With

    .Worksheets("Receipt1").Copy after:=.Sheets(.Sheets.Count)
    ActiveSheet.Name = "Receipt" & 1 + IV: Rpl

    .Worksheets("SWB service1").Copy after:=.Sheets(.Sheets.Count)
    ActiveSheet.Name = "SWB service" & 1 + V: [AX30:BF52].Activate
    Selection.NumberFormat = fmt: Rpl

    Worksheets("BL Mobile" & 1 + I).Select
  End With
  Application.EnableEvents = -1
End Sub

Le code VBA des 3 feuilles est court.
----------------------------------------------------------------------------------------

Pour envoyer ton gros fichier, tu peux aller sur le site (gratuit) mon-partage.fr

Attention : il y aura un lien de téléchargement à copier / coller
dans ton prochain post !

Seuls ceux à qui tu passes ce lien peuvent accéder à ton fichier.

soan

 

[sebbbbb]

Merci Soan
j'ai collé le code dans mon fichier et exactement même problème qu'avec celui de Kiki. pourtant j'ai pris le soin de rajouter un 1 a la fin de thiswoorkbook vu rien de plus.

a nouveau copie écran

je vais essayer d'envoyer le lien pour tel mon fichier

merci

 

[sebbbbb]

voici l'adresse du lien wetransfer pour tel mon fichier
merci bcp

 

[soan]

@sebbbbb

Réponse à ton post #26

Une feuille de calcul a un .CodeName et un .Name ; ThisWorkbook1 est considéré
par VBA comme une feuille de calcul ; son .CodeName est ThisWorkbook1, mais
il n'y a pas de .Name ; dans la sub Impression(), boucle For Each Wsh .. Next Wsh :
Ar(I) = Wsh.Name ➯ dans la boucle For I .. Next I : Set Wsh = Worksheets(Ar(I))
cause un plantage !

Dans ton post #24, tu as écrit : « je sais que ThisWorkbook1 n'est pas normal mais
je m'en accommode » ; sauf que tu as quand même un plantage à cause de cette
anomalie, et je vois mal comment le code VBA pourra fonctionner avec.

Comment expliques-tu que ça marche sur le fichier joint, où il n'y a pas de
ThisWorkbook1, et que sur ton fichier réel où ThisWorkbook1 est présent,
ça plante tout à coup ?

-------------------------------------------------------------------------------------------

Tu as écrit : « pourtant j'ai pris le soin de rajouter un 1 à la fin de ThisWorkbook »

ThisWorkbook représente le classeur en cours ; si tu utilises ThisWorkbook1,
alors que c'est considéré par VBA comme une feuille de calcul, ça ne peut
pas marcher !

Si je me trompe et que ThisWorkbook1 est considéré comme un classeur,
c'est encore pire car un classeur Excel ne peut contenir qu'un seul objet
le désignant, et cet objet est par défaut ThisWorkbook ; la présence du
"classeur-doublon" ThisWorkbook1 ne peut que le gêner !

Si là aussi je me trompe, c'est de toute façon une situation anormale
qui n'a absolument pas lieu d'être, et dans laquelle on ne peut que
être dans l'expectative ! pour moi, c'est inutile d'élaborer de vaines
conjectures à partir d'une telle situation anormale.

Dans mon post #23, j'avais bien écrit :

« Je ne sais pas ce que tu as fait pour avoir un ThisWorkbook1
en plus de ThisWorkbook, mais d'une façon ou d'une autre,
il faut vraiment que tu arranges ça !!! »

soan

 

[sebbbbb]

Merci Soan

j'ai bien conscience que ce foutu thisworkbook1 n'est pas normal mais jusqu'a présent celà n'entrainait pas de consequence facheuse. Je crois vraiment que c'est un classeur bis. j'ai lu celà dans divers sujets (ouf je suis pas le seul)

bon je vais donc me résigner a ne pas utiliser ce code qui me semblait pourtant bien pratique

je bosse sur ce fichier depuis plus de 2 ans pour mon boulot et je me vois mal recommencer à 0

merci a vous tous
seb

 

[soan]

Suggestion :

* tu crées un nouveau classeur vierge .xlsm
* Alt F11 pour aller sur l'éditeur VBA
* tu vérifies qu'il n'y a pas de ThisWorkbook1 mais seulement ThisWorkbook

* tu copies toutes les feuilles de ton classeur réel dans le nouveau classeur
* tu copies tout le code VBA

Ça sera un peu long et fastidieux à faire, mais c'est faisable
sans devoir tout recommencer à 0 !

soan

 

[sebbbbb]

Merci pour le conseil