Bloquer un bouton de macro

S

stephane.quinquis

XLDnaute Junior
Bonjour le forum,

J'ai une macro relié à un bouton. Ma macro transfère des données d'un classeur vers un autre classeur ligne par ligne.
Code: 
Sub validationrefonteligne6()
'
' validationrefonte Macro
' Macro enregistrée le 12/04/2010 par quinquis

Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\inventaire production.xls"
    Rows("7:7").Select
    Range("E7").Activate
    Selection.Insert Shift:=xlDown
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Interior.ColorIndex = 2
    Selection.Font.ColorIndex = 0
    ActiveWindow.SmallScroll ToRight:=-4
    Range("O7:EL7").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    Windows("GRAM-vierge.xls").Activate
    Range("B6").Select
    Selection.Copy
   Windows("inventaire production.xls").Activate
    Range("M7").Select
    ActiveSheet.Paste
    Windows("GRAM-vierge.xls").Activate
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("E7").Select
    ActiveSheet.Paste
    Windows("GRAM-vierge.xls").Activate
    Range("D6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("L7").Select
    ActiveSheet.Paste
    Windows("GRAM-vierge.xls").Activate
    Range("E6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("C7").Select
    ActiveSheet.Paste
    Windows("GRAM-vierge.xls").Activate
    Range("Q6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("D7").Select
   Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("R6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("S6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("G7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("T6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("K7").Select
   Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("U6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("H7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("V6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("I7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("W6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    ActiveWindow.SmallScroll ToRight:=3
    Range("J7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("X6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Windows("GRAM-vierge.xls").Activate
    Range("Y6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("inventaire production.xls").Activate
    Range("B7").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    ActiveWindow.SmallScroll ToRight:=-7
    Range("B6:Y6").Select
    Selection.Interior.ColorIndex = 6
End Sub

J'ai une case avec initiales en D5. Et par exemple en D6 une personne doit rentrer ses initiales.

Ma macro doit faire la chose suivante:
Si la case D6 est vide alors la macro ne s'éxécute pas et donc le transfert de données ne se fait pas

Si possible également afficher une message box avec"erreur car manque les initiales".

Mon problème essentiel est de savoir si je construis une autre macro pour cette condition ou alors si je peux le placer en début de macro.

Merci d'avance
 
Trier par date Trier par votes
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

bonjour stephane

Au lieu de nous infliger la lecture interminable d'un code qui abonde de lignes inutiles , il serait plus simple de nous fournir un fichier exemple avec quelques explications claires de ce que tu souhaites
 
Vote positif 0 Vote négatif
Dull

Dull

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

Salut Steph29, le Forum

Si j'ai bien compris ajoute cette ligne en début de procédure

Code: 
If ActiveSheet.Range("D6") = "" Then MsgBox "Veuillez Entrer vos initiales en D6": Exit Sub
en espérant que la cellule D6 soit sur la feuille Active sinon remplace ActiveSheet par Sheets("LeNomDeTaFeuille")

EDITION: HeureuxdetecroiserAmiPierre :)
Bonne Journée
 
Vote positif 0 Vote négatif
Paritec

Paritec

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

bonsoir stephane.quinquis
tu ajoutes
Code: 
if range("D6")= "" then exit sub
sans fichier voilà tout ce que je peux te dire
place le avant la commande de la macro dans ton bouton
a+
papou :)

EDIT bonjour Pierrejean, Bonjour Dull bon encore en retard moi mais un jour peut-être je serai plus rapide a+
 
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Bloquer un bouton de macro

Bonsoir,

Merci pour vos réponses.
Pour Pierrejean, désolé pour le manque de fichierjoint. Je le fais pour l'exemple prochain
Pour Dull et Papou, j'ai pris la message box de Dull qui semble bien fonctionner.
Merci encore.

J'ai juste une autre question. J'ai joint un fichier exemple mais la macro au dessus ne correspond pas tout à fait à cela.
Je souhaite bloquer le bouton si les intiales ne sont pas remplis en D6 ou si les cellules de B6 à G6 sont surlignés en jaune.

Merci d'avance
 

Pièces jointes

  • inventaire production exemple.xls
    32.5 KB · Affichages: 87
  • inventaire production exemple.xls
    32.5 KB · Affichages: 87
  • inventaire production exemple.xls
    32.5 KB · Affichages: 86
Vote positif 0 Vote négatif
Paritec

Paritec

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

Bonsoir Pierrjean Dull, stephane.quinquis,
alors tu veux que l'on teste la présence ou non d'initiale dans D6 ???? alors que tu as le titre de ta colonne!!!
Et après tu parles de tester les lignes ?????? je pense que tu veux faire allusion aux cellules de la colonne D sur la même ligne que tes boutons????
et pour les cellules surlignées alors là ???????????????????????????????
elles sont ou les cellules surlignées et dans quel cas le sont elles??
en bref des explications dans le fichiers, si possibles intelligibles seraient les bienvenues
a+
Papou :)
 
Dernière édition:
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Bloquer un bouton de macro

Bonjour Dull, papou et pierrejean

Désolé pour les explications. J'ai remis un fichier avec des explications plus claires je l'espère. Merci de chercher des solutions à mes problèmes.
 

Pièces jointes

  • inventaire production exemple.xls
    36.5 KB · Affichages: 89
  • inventaire production exemple.xls
    36.5 KB · Affichages: 110
  • inventaire production exemple.xls
    36.5 KB · Affichages: 100
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

Bonjour à tous,
Pourquoi multiplier les boutons, codes...alors qu'un simple double-click dans la plage suffirait
Dans le module de la feuille
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dl As Long, L As Long, rng As Range
dl = Range("A65000").End(xlUp).Row
L = Target.Row
If Intersect(Target, Range("A7:F" & dl)) Is Nothing Then Exit Sub
Cancel = True
If Target.Interior.ColorIndex <> xlNone Then
    MsgBox "Déjà validé !"
    Exit Sub
End If
If Cells(L, 3) = "" Then
    MsgBox "Indiqez vos initiales dans la cellule " & Cells(L, 3).Address(0, 0)
    Cells(L, 3).Select
    Exit Sub
End If
Set rng = Range(Cells(L, 1), Cells(L, 6)) 'la plage à transférer
'Transfert (rng) 'la macro qui transfert les données, à adapter
rng.Interior.ColorIndex = 6 'colore la plage transférée

End Sub
A+
kjin
 
Vote positif 0 Vote négatif
Paritec

Paritec

XLDnaute Barbatruc
Re : Bloquer un bouton de macro

Bonjour Kjin stéphane,
oui Kjin je sais que tu as 100% raison mais c'était ce que je voulais lui dire après, mais je me suis contenté de répondre à sa demande dans un premier temps.
De même si tu regardes sa macro là aussi il y a, à redire mais bon!!
a+
Bonne journée
a+
Papou :)
 
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Bloquer un bouton de macro

Rebonjour,

Je sais papou. Je viens de démarrer en vba et j'apprends petit à petit comment cela fonctionne....mais je galère un peu.
A ce propos, j'ai lancé une autre discussion sur ce forum et vu que vous avez l'air d'être fort en vba.
Sous excel 2000, je n'arrive pas à faire un insertion cellules copiées après avoir fait des filtres automatiques.

https://www.excel-downloads.com/threads/insertion-cellules-copiees.140869/

Un grand merci
 
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Bloquer un bouton de macro

Rebonjour à tous,

J'ai encore une autre demande pour bloquer un bouton.
Je souhaite bloquer le bouton si un autre classeur est déjà ouvert avec une message box indiquant "Utilisation en cours. Veuillez réessayer dans une minute".

J'ai essayé ce code
Code: 
If Workbooks.Open "\\S110dvp02\chefeq\STAGE S QUINQUIS\inventaire production.xls" Then MsgBox "Feuille déjà activé": Exit Sub
mais il bug sur une erreur de compilation

J'ai également essayé ceci
Code: 
If Windows("inventaire production.xls").Activate Then MsgBox "Feuille déjà activé": Exit Sub
Mais il m'indique une erreur 9:l'indice n'appartient pas à la sélection.

Merci
 
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
269
robpellan52
R
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
120
Francky79
F
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
336
gwenn49
G
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
560
Kevin38
K
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
445
olivier388
O
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
606
TooFatBoy
TooFatBoy
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
371
fanou06
F
M
  • Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
115
Marvin57
M

Membres actuellement en ligne

18 membres et 100 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 207
Messages
2 086 234
Membres
103 162
dernier inscrit
fcfg