Impression oui ou non, macro se poursuit !!

V

vkaeros

XLDnaute Nouveau
Bonjour a tous, besoin d'une dernière petite aide pour finaliser mon fichier de gestion de stock, voilà j'ai un code qui me permet d'enregistrer dans une zone de stockage precise et lance l'impression d'un étiquette pour un emballage automatiquement, par contre je voudrais ajouter une ligne avant l'impression avec type une message box qui demande "voulez-vous imprimer l'étiquette" si oui l'impression se lance et la macro continue et si non l'impression se lance pas et la macro continue également.

Merci beaucoup à l'avance

mon code actuel est celui-ci :

Sub ARMOIRESAGESTION()
'
' ARMOIRESAGESTION Macro
'
If IsEmpty(Range("A5").Value) Then MsgBox "Vous n'avez pas renseigné la date de saisie"
If IsEmpty(Range("A5").Value) Then Exit Sub
If IsEmpty(Range("B5").Value) Then MsgBox "Vous n'avez pas renseigné le produit"
If IsEmpty(Range("B5").Value) Then Exit Sub
If IsEmpty(Range("C5").Value) Then MsgBox "Vous n'avez pas renseigné le marquage effectif"
If IsEmpty(Range("C5").Value) Then Exit Sub
If IsEmpty(Range("D5").Value) Then MsgBox "Vous n'avez pas renseigné le numéro d'OP ou LOT"
If IsEmpty(Range("D5").Value) Then Exit Sub
If IsEmpty(Range("E5").Value) Then MsgBox "Vous n'avez pas renseigné le type et numéro d'emballage"
If IsEmpty(Range("E5").Value) Then Exit Sub
If IsEmpty(Range("F5").Value) Then MsgBox "Vous n'avez pas renseigné le poids"
If IsEmpty(Range("F5").Value) Then Exit Sub
If IsEmpty(Range("I5").Value) Then MsgBox "Vous n'avez pas visé"
If IsEmpty(Range("I5").Value) Then Exit Sub
If MsgBox("Voulez-vous stocker en ARMOIRES A ?", vbYesNo) = vbNo Then Exit Sub
Sheets("LIENS").Select
Range("B12").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.Close SaveChanges:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("LIENS").Select
Range("B10").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Windows("etiquette excel MODIF.xlsm").Activate
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
ActiveWindow.Close SaveChanges:=False
Windows("FICHIER DE SUIVI DES ZONES FINAL.xlsm").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("GESTION STOCK").Select
Range("A5").Select
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("A4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("K5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("C4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("D4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("E4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("F4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("G4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("H4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("I4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("J4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("H5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("K4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Range("I5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Armoires de stockage-A").Select
Range("L4").Select
Selection.Insert Shift:=xlDown
Sheets("GESTION STOCK").Select
Sheets("GESTION STOCK").Select
Range("A5,B5,C5,D5,E5,F5,G5,H5,I5,A7:B7,C7").Select
Range("C7").Activate
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A5,B5,C5,D5,E5,F5,G5,H5,I5,A7:B7,C7,E7,K5").Select
Range("K5").Activate
Selection.ClearContents
Range("A1:I1").Select
ActiveWorkbook.Save
'
End Sub
 
Trier par date Trier par votes
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Impression oui ou non, macro se poursuit !!

Bonjour vkaeros

avec ceci:
Code: 
If MsgBox("Voulez-vous inprimer", vbOKCancel) = vbOK Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
End If

à+
Philippe
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Impression oui ou non, macro se poursuit !!

Bonjour Vkaeros et bienvenue sur ce forum

Tout d'abord, merci de bien vouloir mettre ton code entre balises
Code: 
 et [ /code] sans espace entre [ et /

Ensuite voici ton code optimisé[code=vb]Option Explicit
Sub ARMOIRESAGESTION()
'
' ARMOIRESAGESTION Macro
'
  If IsEmpty(Range("A5").Value) Then _
    MsgBox "Vous n'avez pas renseigné la date de saisie": Range("A5").Select: Exit Sub
  If IsEmpty(Range("B5").Value) Then _
    MsgBox "Vous n'avez pas renseigné le produit": Range("B5").Select: Exit Sub
  If IsEmpty(Range("C5").Value) Then _
    MsgBox "Vous n'avez pas renseigné le marquage effectif": Range("C5").Select: Exit Sub
  If IsEmpty(Range("D5").Value) Then _
    MsgBox "Vous n'avez pas renseigné le numéro d'OP ou LOT": Range("D5").Select: Exit Sub
  If IsEmpty(Range("E5").Value) Then _
    MsgBox "Vous n'avez pas renseigné le type et numéro d'emballage": Range("E5").Select: Exit Sub
  If IsEmpty(Range("F5").Value) Then _
    MsgBox "Vous n'avez pas renseigné le poids": Range("F5").Select: Exit Sub
  If IsEmpty(Range("I5").Value) Then _
    MsgBox "Vous n'avez pas visé": Range("I5").Select: Exit Sub
  If MsgBox("Voulez-vous stocker en ARMOIRES A ?", vbYesNo) = vbNo Then Exit Sub
  Sheets("LIENS").Range("B12").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  ActiveWindow.Close SaveChanges:=False
  Sheets("LIENS").Range("B10").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  ' Poser la question pour l'impression
  If MsgBox("Voulez-vous imprimer l'étiquette ?", vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then
    ' Si oui on imprime
    With Workbooks("etiquette excel MODIF.xlsm")
      .Activate
      .SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
      .Close SaveChanges:=False
    End With
  End If
  ' On continue
  With Workbooks("FICHIER DE SUIVI DES ZONES FINAL.xlsm")
    .Activate
    .Sheets("GESTION STOCK").Range("A5").Copy
    .Sheets("Armoires de stockage-A").Range("A4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("K5").Copy
    .Sheets("Armoires de stockage-A").Range("C4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("B5").Copy
    .Sheets("Armoires de stockage-A").Range("D4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("D5").Copy
    .Sheets("Armoires de stockage-A").Range("E4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("C5").Copy
    .Sheets("Armoires de stockage-A").Range("F4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("C7").Copy
    .Sheets("Armoires de stockage-A").Range("G4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("E5").Copy
    .Sheets("Armoires de stockage-A").Range("H4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("F5").Copy
    .Sheets("Armoires de stockage-A").Range("I4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("G5").Copy
    .Sheets("Armoires de stockage-A").Range("J4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("H5").Copy
    .Sheets("Armoires de stockage-A").Range("K4").Paste Shift:=xlDown
    .Sheets("GESTION STOCK").Range("I5").Copy
    .Sheets("Armoires de stockage-A").Range("L4").Paste Shift:=xlDown
    With .Sheets("GESTION STOCK").Range("A5,B5,C5,D5,E5,F5,G5,H5,I5,A7:B7,C7")
      With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    End With
    With Range("A5,B5,C5,D5,E5,F5,G5,H5,I5,A7:B7,C7,E7,K5").ClearContents
    Range("A1:I1").Select
    ActiveWorkbook.Save
End Sub

En revanche sans fichier difficile de tester ;)

Edit : salut phlaurent55 ;)

A+
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
298
robpellan52
R
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
269
Compte Supprimé 979
C
P
  • Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
250
mapomme
mapomme
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
248
gbinforme
G
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
396
fanou06
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
567
mouchtre
mouchtre
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
134
marie3107
M
Z
  • Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
969
onobyone
O
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
226
Francky79
F
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne

Membres actuellement en ligne

Aucun membre en ligne actuellement.
2 membres et 45 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 413
Messages
2 088 199
Membres
103 763
dernier inscrit
p.michaux