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

David-DR

XLDnaute Nouveau
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
 
Solution
Re

Et avec cette version, c'est mieux ?
VB:
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 ;)

Staple1600

XLDnaute Barbatruc
Re

Fallait que j'occupe mon dimanche car il fait très beau dehors
Donc une version avec tableau structuré
VB:
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

XLDnaute Nouveau
Re

Fallait que j'occupe mon dimanche car il fait très beau dehors
Donc une version avec tableau structuré
VB:
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 ?
VB:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Re

C'est pourtant la même logique que ma proposittion précédente
Code:
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
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou