Bloquer un bouton de macro

stephane.quinquis · 3 Mai 2010

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

pierrejean · 3 Mai 2010

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

Dull · 3 Mai 2010

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

Paritec · 3 Mai 2010

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+

stephane.quinquis · 3 Mai 2010

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

Paritec · 3 Mai 2010

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 🙂

stephane.quinquis · 4 Mai 2010

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.

Paritec · 4 Mai 2010

Re : Bloquer un bouton de macro

Bonjour Stéphane,
regardes dans le fichier joint si cela serait ce que tu souhaites
a+
papou 🙂

kjin · 4 Mai 2010

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

stephane.quinquis · 4 Mai 2010

Re : Bloquer un bouton de macro

Bonjour papou et kjin,

Merci à vous deux pour vos réponses.
La solution de papou fonctionne très bien et correspond à ce que je veux.
Pour kjin, je teste dans l'après-midi si ta solution est plus adéquate.

kjin · 4 Mai 2010

Re : Bloquer un bouton de macro

Re,
Note quand même que j'ai supprimé la colonne validation et les boutons qui ne servent plus dans ces conditions
A+
kjin

Paritec · 4 Mai 2010

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 🙂

kjin · 4 Mai 2010

Re : Bloquer un bouton de macro

Re,
Bonjour Papou 🙂, ma remarque n'était pas adressée à toi personnellement 😉
A+
kjin

stephane.quinquis · 4 Mai 2010

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

stephane.quinquis · 4 Mai 2010

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

Effectuez une recherche sur Excel Downloads...

Bloquer un bouton de macro

stephane.quinquis

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

Dull

XLDnaute Barbatruc

Paritec

XLDnaute Barbatruc

stephane.quinquis

XLDnaute Junior

Pièces jointes

Paritec

XLDnaute Barbatruc

stephane.quinquis

XLDnaute Junior

Pièces jointes

Paritec

XLDnaute Barbatruc

Pièces jointes

kjin

XLDnaute Barbatruc

stephane.quinquis

XLDnaute Junior

kjin

XLDnaute Barbatruc

Paritec

XLDnaute Barbatruc

kjin

XLDnaute Barbatruc

stephane.quinquis

XLDnaute Junior

stephane.quinquis

XLDnaute Junior

Discussions similaires

Nous accordons de l'importance à votre vie privée