XL 2016 Mettre l'année en cours dans la cellule active

[David-DR]

Bonjour à tous,
Je suis novice en VBA et je souhaiterai rajouter dans mon code, l'ajout automatiquement l'année suivant la date en colonne B de la même ligne.
Merci d'avance.

Sub nouvelle_utilisation()

' Annulation des filtres
If Sheets("Utilisation").AutoFilterMode = True Then
Sheets("Utilisation").Range("A3:K3").AutoFilter
Else
Sheets("Utilisation").Range("A3:K3").AutoFilter
End If

' Rechercher la dernière cellule A du tableau et Incrementer un n° saisie
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"

' Rechercher la dernière cellule B du tableau et ajouter la date du jour
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Now

' Rechercher la dernière cellule D du tableau et ajouter le Nom de l'imprimante
Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Value = "Ultimaker 5S"

' Rechercher la dernière cellule H du tableau et ajouter le temps de preparation
Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Value = "0:30"

' Se placer sur la dernière cellule vide du tableau dans la colonne B et se décaler de 3 cellules sur la droite soit en colonne E
Range("B" & Rows.Count).End(xlUp).Offset(0, 3).Select


End Sub

 

[David-DR]

Je ne l'ai pas encore analysé.
Mais je pense que j'en aurai.

 

[Staple1600]

Re

Fallait que j'occupe mon dimanche car il fait très beau dehors
Donc une version avec tableau structuré

Sub Avec_tableau_structuré()
Dim L_o As ListObject, X&
Set L_o = Sheets("Utilisation").ListObjects(1)
Application.ScreenUpdating = False
L_o.ListRows.Add AlwaysInsert:=True
X = L_o.DataBodyRange.Rows.Count
L_o.ListColumns(1).Range(X + 1, 2) = InputBox("Nouvelle Date?", "Date", Date)
L_o.DataBodyRange.Formula = L_o.DataBodyRange.Formula
End Sub

NB:
En A4, j'ai mis cette formule: =LIGNE()-3
En H4, j'ai mis cette formule : ="01:00"/2

Avec cette méthode, tu construis ton tableau structuré et sur la 1ère ligne tu mets les formules et/ou valeurs idoines.
A chaque exécution, elles seront reproduites sur la ligne nouvellement insérée.
On peut ajouter également une liste de validation pour choisir le modèle d'Imprimante
(elle sera également reproduite sur la nouvelle ligne)

 

[David-DR]

Re

Fallait que j'occupe mon dimanche car il fait très beau dehors
Donc une version avec tableau structuré

Sub Avec_tableau_structuré()
Dim L_o As ListObject, X&
Set L_o = Sheets("Utilisation").ListObjects(1)
Application.ScreenUpdating = False
L_o.ListRows.Add AlwaysInsert:=True
X = L_o.DataBodyRange.Rows.Count
L_o.ListColumns(1).Range(X + 1, 2) = InputBox("Nouvelle Date?", "Date", Date)
L_o.DataBodyRange.Formula = L_o.DataBodyRange.Formula
End Sub

NB:
En A4, j'ai mis cette formule: =LIGNE()-3
En H4, j'ai mis cette formule : ="01:00"/2

Avec cette méthode, tu construis ton tableau structuré et sur la 1ère ligne tu mets les formules et/ou valeurs idoines.
A chaque exécution, elles seront reproduites sur la ligne nouvellement insérée.
On peut ajouter également une liste de validation pour choisir le modèle d'Imprimante
(elle sera également reproduite sur la nouvelle ligne)

Re

Et avec cette version, c'est mieux ?

Sub n_utilisation()
Dim Valeurs, r As Range: Set r = Cells(Rows.Count, 1).End(3)(2)
Valeurs = Array("=R[-1]C+1", Date, "=IF(RC[-2]="""","""",YEAR(RC[-1]))", "Ultimaker 5S")
r.Resize(, 4).Formula = Valeurs: r.Offset(, 7) = "0:30"
End Sub

Si tu as des questions sur cette version, n'hésites pas

Ce code fonctionne à merveille mais je n'arrive pas à le déchiffrer.
serait-possible de me mettre l'explication détaillée de chaque ligne?
Et le dernier code que tu as fait pour le tableau structuré, là tu m'as perdu totalement. j'ai encore beaucoup de choses à apprendre.
Par-contre on est d'accord il faut que je créé des formules dans le tableau hormis la date que tu demandes dans le message lors de l'exécution de la macro ?

 

[David-DR]

Ce code fonctionne à merveille mais je n'arrive pas à le déchiffrer.
serait-possible de me mettre l'explication détaillée de chaque ligne?
Et le dernier code que tu as fait pour le tableau structuré, là tu m'as perdu totalement. j'ai encore beaucoup de choses à apprendre.
Par-contre on est d'accord il faut que je créé des formules dans le tableau hormis la date que tu demandes dans le message lors de l'exécution de la macro ?

J'ai repris le code pour le faciliter la saisie.
il fonctionne mais je te laisse me donner tes remarques.

Sub n_utilisation()

' Annulation des filtres
If Sheets("Utilisation").AutoFilterMode = True Then
Sheets("Utilisation").Range("A3:K3").AutoFilter
Else
Sheets("Utilisation").Range("A3:K3").AutoFilter
End If

Dim Valeurs, r As Range: Set r = Cells(Rows.Count, 1).End(3)(2)
Valeurs = Array("=R[-1]C+1", Date, "=IF(RC[-2]="""","""",YEAR(RC[-1]))", "Ultimaker 5S")
r.Resize(, 4).Formula = Valeurs: r.Offset(, 7) = "0:30"

' Se placer sur la dernière cellule vide du tableau dans la colonne B et se décaler de 3 cellules sur la droite soit en colonne E
Range("B" & Rows.Count).End(xlUp).Offset(0, 3).Select

End Sub

 

[Staple1600]

Re

C'est pourtant la même logique que ma proposittion précédente

Sub n_utilisation()
'Déclaration des variables
Dim Valeurs, r As Range
'Définition d'une cellule (Range en anglais)
'ici r= 1er cellule vide de la colonne A en partant de la fin
Set r = Cells(Rows.Count, 1).End(3)(2)
'On remplit le tableau Valeurs
'avec ce qu'on insérer dans la nouvelle ligne
Valeurs = Array("=R[-1]C+1", Date, "=IF(RC[-2]="""","""",YEAR(RC[-1]))", "Ultimaker 5S")
'Ici on redimensionne le Range et on insére le contenu de Valeurs
r.Resize(, 4).Formula = Valeurs
'Ici en partant de r on se décale avec Offset pour aller mettre une valeur en colonne H
r.Offset(, 7) = "0:30"
End Sub

Conseil en passant:
tu peux insérer des Msgbox dans le code quand tu fais des tests pour avoir des infos
Exemple

Sub n_utilisationC()
Dim Valeurs, r As Range
Set r = Cells(Rows.Count, 1).End(3)(2)
MsgBox r.Address 'test
MsgBox r.Row 'test
Valeurs = Array("=R[-1]C+1", Date, "=IF(RC[-2]="""","""",YEAR(RC[-1]))", "Ultimaker 5S")
MsgBox r.Resize(, 4).Address 'test
r.Resize(, 4).Formula = Valeurs
MsgBox r.Offset(, 7).Address 'test
r.Offset(, 7) = "0:30"
End Sub