Insertion user name dans une macro deja existante

O

olivier972

XLDnaute Occasionnel
Bonjour à tous,

Je vous joint une macro que j'ai créé, dans cette macro juste avant l'impression j'aimerais inserer le nom d'utilisateur en case M65.
Sauriez vous m'aider ?

Grand merci par avance.

Cdlt

Sub IMPRESSIONDR2017()
'
' IMPRESSIONDR2017 Macro
'

'
ActiveSheet.Unprotect
Range("J4").Select
ActiveCell.FormulaR1C1 = "='HISTORIQUE DR'!R[-2]C[-4]+1"
Range("A4:D4").Select
Sheets("HISTORIQUE DR").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("OUVERTURE DR").Select
Rows("1:3").Select
Range("A3").Activate
Selection.EntireRow.Hidden = False
Rows("2:2").Select
Selection.Copy
Sheets("HISTORIQUE DR").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:4").Select
Range("A4").Activate
Selection.EntireRow.Hidden = False
Range("A2:B2").Select
Sheets("OUVERTURE DR").Select
Rows("1:2").Select
Range("A2").Activate
Selection.EntireRow.Hidden = True
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Save
Range("A4:D4").Select
Selection.ClearContents
Range("E4").Select
Selection.ClearContents
Range("J4").Select
Selection.ClearContents
Range("A7:E7").Select
Selection.ClearContents
Range("F7:J7").Select
Selection.ClearContents
Range("K7:O7").Select
Selection.ClearContents
Range("C10:D10").Select
Selection.ClearContents
Range("A10:B10").Select
Selection.ClearContents
Range("E10:G10").Select
Selection.ClearContents
Range("H10:I10").Select
Selection.ClearContents
Range("J10").Select
Selection.ClearContents
Range("K10:M10").Select
Selection.ClearContents
Range("N10:O10").Select
Selection.ClearContents
Range("A14:B14").Select
Selection.ClearContents
Range("C14").Select
Selection.ClearContents
Range("D14").Select
Selection.ClearContents
Range("F14:H14").Select
Selection.ClearContents
Range("I14:O14").Select
Selection.ClearContents
Range("A19:G19").Select
Selection.ClearContents
Range("H19:O19").Select
Selection.ClearContents
Range("A23:C23").Select
Selection.ClearContents
Range("D23:E23").Select
Selection.ClearContents
Range("F23:J23").Select
Selection.ClearContents
Range("K23:O23").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
Range("F26:H26").Select
Selection.ClearContents
Range("D27:O30").Select
Selection.ClearContents
Range("D31:E32").Select
Selection.ClearContents
Range("F32:H32").Select
Selection.ClearContents
Range("I31:O32").Select
Selection.ClearContents
Range("F33:H33").Select
Selection.ClearContents
Range("I33:J34").Select
Selection.ClearContents
Range("K33:O34").Select
Selection.ClearContents
Range("F34:H34").Select
Selection.ClearContents
Range("D34:E34").Select
Selection.ClearContents
Range("D35:O36").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=12
Range("D37:E39").Select
Selection.ClearContents
Range("I37:J39").Select
Selection.ClearContents
Range("K37:O39").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=6
Range("D41:O44").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=12
Range("C48").Select
Selection.ClearContents
Range("E48:I48").Select
Selection.ClearContents
Range("C49").Select
Selection.ClearContents
Range("D49").Select
Selection.ClearContents
Range("E49").Select
Selection.ClearContents
Range("C50:E50").Select
Selection.ClearContents
Range("C51:E51").Select
Selection.ClearContents
Range("C52:E52").Select
Selection.ClearContents
Range("C53:H53").Select
Selection.ClearContents
Range("I53").Select
Selection.ClearContents
Range("J50").Select
Selection.ClearContents
Range("K50:M50").Select
Selection.ClearContents
Range("N50:O50").Select
Selection.ClearContents
Range("J51:O51").Select
Selection.ClearContents
Range("J52:M52").Select
Selection.ClearContents
Range("N52:O52").Select
Selection.ClearContents
Range("J53:O53").Select
Selection.ClearContents
Range("A57:D57").Select
Selection.ClearContents
Range("E57:I57").Select
Selection.ClearContents
Range("J57:O57").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-39
Range("M65:O65").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-78
Range("A4:D4").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
ActiveWorkbook.Save
End Sub
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour olivier :)

Avant de créer une macro, demande aux Xldiens ce que tu veux faire, ça évite de faire le travail deux fois. Là maintenant, on est obligé de nettoyer tout le code. Et quelle est la première feuille activée???

EDIT: bonjour DoubleZero :)
 
Dernière édition:
Vote positif 0 Vote négatif
DoubleZero

DoubleZero

XLDnaute Barbatruc
Bonjour, olivier972, le Forum,

Avant :
Code: 
 ActiveSheet.Protect Objectivations:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True

Insérer :
Code: 
Range("m65") = Environ("username")

Nota : éviter, autant que possible, l'emploi des "select". Pour cela, clic ici.

A bientôt :)

P. S. : Bonjour, Lone-wolf :)
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Rebonjour à toutes et à tous

VB: 
Option Explicit
Sub Impression()

With Sheets("BASE")
.Range("j4").FormulaR1C1 = "='HISTORIQUE DR'!R[-2]C[-4]+1"
End With

With Sheets("OUVERTURE DR").Select
.Rows("1:3").EntireRow.Hidden = False
.Rows("2:2").Copy
End With

With Sheets("HISTORIQUE DR")
.Range("m65") = Environ("username")
.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("2:2").PasteSpecial Paste:=xlPasteValues
Sheets("OUVERTURE DR").Rows("1:2").EntireRow.Hidden = True
Application.CutCopyMode = False
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1

With Sheets("HISTORIQUE DR")
.Range("a4:e4", "j4", "a7:07", "a10:010", "a14:d14", "f14:o14", "a19:o19", _
"a23:o23", "f26:h26", "d27:o30", "d31:e32",  "f32:h32", "i31:032", "f33:h33",  _
"I33:J34", "k33:o34", "f34:h34", "d34:e34", "d35:o36", "d37:e39", "i37:j39",  _
"k37:o39", _"d41:o44", "c48", "e48:i48", "c49:e49", "c50:e52", "c53:i53",  _
"j50:o52", "a57:i57", "m65:o65").ClearContents
End With

ActiveSheet.Protect Objectivations:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True

ActiveWorkbook.Save

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
626
Phil69970
Phil69970
R
  • Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
512
robbynasch
R
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
287
Francky79
F
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
492
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
488
Compte Supprimé 979
C
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
523
fanou06
F
B
  • Question
XL 2016 Interférence entre une boucle et un copie de feuille
Réponses
4
Affichages
499
Oneida
Oneida
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
812
mouchtre
mouchtre
F
  • Question
XL 2010 Appeler une macro dans une autre
Réponses
5
Affichages
498
Dranreb
Dranreb
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
474
Usine à gaz
Usine à gaz

Membres actuellement en ligne

7 membres et 69 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
314 628
Messages
2 111 342
Membres
111 107
dernier inscrit
cdel