Récupérer une donnée pour l'utiliser dans un autre macro
Ferméyg_be Messages postés 23480 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 3 mars 2025 - 7 déc. 2022 à 18:11
Bonjour,
Je suis débutant en VBA et je rencontre un probleme pour récupérer une valeur et ensuite m'en servir dans une autre macro, j'explique :
j'ai un fichier avec des boutons qui me sert pour lancer une macro qui met en forme plusieurs fichiers en y incluant une formule de calcul
Dans ce fichier en cellule A1 je saisi un chiffre, ce chiffre doit ensuite servir dans ma formule de calcul dans la macro de mise en forme.
A ce jour j'arrive à récupérer la valeur de la cellule dans une variable mais je n'arrive pas à utiliser ensuite cette variable dans l'autre macro
Merci de votre aide
Windows / Firefox 107.0
- Récupérer une donnée pour l'utiliser dans un autre macro
- Utiliser chromecast - Guide
- Comment recuperer un message supprimé sur whatsapp - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Recuperer video youtube - Guide
- Comment récupérer un compte facebook piraté - Guide
10 réponses
Modifié le 22 nov. 2022 à 10:59
Bonjour,
Evitez les demandes multiples
Excel vba (commentcamarche.net)
Montrez le code de votre macro pour que nous puissions vous aider
22 nov. 2022 à 15:41
Dans mon fichier "Lanceur_macro_Revalorisation"
j'inscris dans la cellule J9 une valeur
Ensuite je clique sur le bouton qui lance une macro de mise en forme des fichiers situés dans un répertoire, lors de cette mise en forme j'intégre une cellule de calcul basé dur la valeur sai en J9 de mon fichier "Lanceur_macro_Revalorisation"
Sub Taux_Revalorisation()
Dim TauxRevalo As Double
TauxRevalo = Worbooks.Open("Lanceur_macro_Revalorisatio").Sheets("Feuil1").Range("J9").Value
'Range("J9").Select
'TauxRevalo = Cells(9, 10)
MsgBox TauxRevalo
End Sub
22 nov. 2022 à 15:42
basé sur la valeur saisie
22 nov. 2022 à 18:48
bonjour,
si les deux macros sont dans le même fichier, je pense que le plus simple, pour un débutant, est de mémoriser la valeur dans une cellule de ce fichier.
tu as deux macros, tu nous en montres une, pas l'autre. ce que tu nous montres fonctionne bien?
ta cellule, c'est A1 ou J9?
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question23 nov. 2022 à 10:14
Voici les macros, j'espère que cela sera plus clair pour vous
merci
Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""
Workbooks.Open Chemin & Fich
RevalorisationCotisation
'traduction_données_brutes
ActiveWorkbook.Close True
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub RevalorisationCotisation()
Dim repertoire As String
Application.ScreenUpdating = True
Rows("1:1").Select
Range("B1").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A4").Select
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("B2:C2").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Range("D2").Activate
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("K1").Select
' Taux_Revalorisation ' A ce moment du traitement, je veux intégrer la valeur récupérée en cellule A1 de mon fichier "Lanceur_macro_Revalorisation"
ActiveCell.FormulaR1C1 = TauxRevalo
Selection.NumberFormat = "0.25%"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("C3").Select
ActiveCell.FormulaR1C1 = "Date adhésion"
Range("D3").Select
ActiveCell.FormulaR1C1 = "Cotisation actuelle"
Range("E3").Select
ActiveCell.FormulaR1C1 = "% d'ancienneté"
Range("F3").Select
ActiveCell.FormulaR1C1 = "Coefficient"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Autres primes"
Range("H3").Select
ActiveCell.FormulaR1C1 = "Temps de travail"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Montant cotisation"
Range("J3").Select
ActiveCell.FormulaR1C1 = "Après déduction fiscale"
Range("K3").Select
ActiveCell.FormulaR1C1 = "Cotisation proposée par le BN"
Range("A3:K3").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.Font.Bold = True
End With
Range("B3").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.NumberFormat = "0%"
Columns("H:H").Select
Selection.NumberFormat = "0%"
Range("A3").Select
ActiveCell.FormulaR1C1 = "Valeur du point 100 au 01 décembre de cette année :"
Range("E3").Select
Selection.NumberFormat = "0.000"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Nbre de salaires annuels :"
Range("B1:H1").Select
Selection.Merge
Range("B1:H1").Select
ActiveCell.FormulaR1C1 = "REVALORISATION DES COTISATIONS"
Range("B1:H1").Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
With Selection.Font
.Name = "Calibri"
.Size = 16
End With
Range("A3:J3").Select
With Selection
Selection.Font.Bold = True
End With
Range("A5:K5").Select
Range("K3").Activate
Selection.Font.Bold = True
Range("I3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("E3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("I6").Select
ActiveCell.FormulaR1C1 = _
"=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6").Select
Selection.NumberFormat = "0.00"
Range("J6").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*0.34"
Range("J6").Select
Selection.NumberFormat = "0.00"
Range("K6").Select
Selection.NumberFormat = "0.00"
Range("I6").Select
CopierFormuleH
Range("J6").Select
CopierFormuleI
Range("K6").Select
CopierFormuleK
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Tableau4"
Range("D:E,G:K").Select
Range("G2").Activate
Selection.ColumnWidth = 12
Range("A5:K5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("H6").Select
ActiveCell.FormulaR1C1 = "100%"
Range("H6:H" & [A65536].End(xlUp).Row).FillDown
'Range("H6:H15").Select
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 14.5
Range("K6").Select
ActiveCell.FormulaR1C1 = "=((RC[-7]*R1C11)+(RC[-7]))"
Range("K6").Select
Range("K6").Select
' ActiveWorkbook.Save 'enregistrer les modifications
' ActiveWorkbook.Close 'Fermer
End Sub
Sub CopierFormuleH()
[I6].Formula = "=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6:I" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleI()
[J6].Formula = "=RC[-1]*0.34"
Range("J6:J" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleK()
[K6].Formula = "=((RC[-7]*R[-5]C)+(RC[-7]))"
Range("K6:K" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub Taux_Revalorisation()
Dim TauxRevalo As Double
TauxRevalo = Worbooks.Open("Lanceur_macro_Revalorisatio").Sheets("Feuil1").Range("J9").Value
'Range("J9").Select
'TauxRevalo = Cells(9, 10)
MsgBox TauxRevalo
End Sub
23 nov. 2022 à 11:36
le fichier "Lanceur_macro_Revalorisation", c'est celui dans lequel se trouve la macro? si oui:
TauxRevalo = thisworkbook.sheets("lenomdelafeuille").[a1]
23 nov. 2022 à 13:32
Cela génère une erreur 404 Objet requis
23 nov. 2022 à 13:35
Es-tu certain d'avoir mis le bon nom de feuille? Peux-tu montrer ton code?
Veille à tenir compte de ceci: https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code
30 nov. 2022 à 12:47
as-tu bien écrit "thisworkbook"?
il est aussi utile d'ajouter "option explicit" en début de module.
30 nov. 2022 à 10:24
La procédrure
1- j'ouvre le fichier "Lanceur-macro-Revalorisation" Feuil1
2- je renseigne la cellule J9
3- je lance la macro via le bouton
4- A chaque boucle un fichier est mis en forme selon la macro "Sub RevalorisationCotisation()" Pour chaque fichier traité je veux renseigner la cellule K1 de la valeur saisie en J9 du fichier "Lanceur-macro-Revalorisation"
Et cela ne fonctionne pas
Merci de votre aide
Ce n'est pas moi qui est écrit les trois macros ci-dessous, je les aies copiées sur internet et adaptées à mes besoins
Public Sub repertoire(), Private Function FLoadNomDuREP et Private Sub BoucleDeTraitement()
Public Chemin, Fich As String, ReponseMsgBox As Variant
' .
'routine d'appel depuis le bouton sur feuille
' .
Public Sub repertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xlsx du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
' Taux_Revalorisation
BoucleDeTraitement ' appel la routine de traitement des fichiers
MsgBox "Traitement terminé !", vbInformation
Else
MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub
' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
REP = objFolder.Items.Item.Path
If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function
Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""
Workbooks.Open Chemin & Fich
RevalorisationCotisation
'traduction_données_brutes
ActiveWorkbook.Close True
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub RevalorisationCotisation()
Dim repertoire As String
Application.ScreenUpdating = True
Rows("1:1").Select
Range("B1").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A4").Select
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("B2:C2").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Range("D2").Activate
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' renseigner valeur revalorisation
' au lieu de l'écrire en dur dans la macro, je souhaite récupérer la valeur saisie
'dans le fichier "lanceur macro revalorisation"
Range("K1").Select
ActiveCell.FormulaR1C1 = "25%"
Selection.NumberFormat = "0.00"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("C3").Select
ActiveCell.FormulaR1C1 = "Date adhésion"
Range("D3").Select
ActiveCell.FormulaR1C1 = "Cotisation actuelle"
Range("E3").Select
ActiveCell.FormulaR1C1 = "% d'ancienneté"
Range("F3").Select
ActiveCell.FormulaR1C1 = "Coefficient"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Autres primes"
Range("H3").Select
ActiveCell.FormulaR1C1 = "Temps de travail"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Montant cotisation"
Range("J3").Select
ActiveCell.FormulaR1C1 = "Après déduction fiscale"
Range("K3").Select
ActiveCell.FormulaR1C1 = "Cotisation proposée par le BN"
Range("A3:K3").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.Font.Bold = True
End With
Range("B3").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.NumberFormat = "0%"
Columns("H:H").Select
Selection.NumberFormat = "0%"
Range("A3").Select
ActiveCell.FormulaR1C1 = "Valeur du point 100 au 01 décembre de cette année :"
Range("E3").Select
Selection.NumberFormat = "0.000"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Nbre de salaires annuels :"
Range("B1:H1").Select
Selection.Merge
Range("B1:H1").Select
ActiveCell.FormulaR1C1 = "REVALORISATION DES COTISATIONS"
Range("B1:H1").Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
With Selection.Font
.Name = "Calibri"
.Size = 16
End With
Range("A3:J3").Select
With Selection
Selection.Font.Bold = True
End With
Range("A5:K5").Select
Range("K3").Activate
Selection.Font.Bold = True
Range("I3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("E3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("I6").Select
ActiveCell.FormulaR1C1 = _
"=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6").Select
Selection.NumberFormat = "0.00"
Range("J6").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*0.34"
Range("J6").Select
Selection.NumberFormat = "0.00"
Range("K6").Select
Selection.NumberFormat = "0.00"
Range("I6").Select
CopierFormuleH
Range("J6").Select
CopierFormuleI
Range("K6").Select
CopierFormuleK
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Tableau4"
Range("D:E,G:K").Select
Range("G2").Activate
Selection.ColumnWidth = 12
Range("A5:K5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("H6").Select
ActiveCell.FormulaR1C1 = "100%"
Range("H6:H" & [A65536].End(xlUp).Row).FillDown
'Range("H6:H15").Select
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 14.5
Range("K6").Select
ActiveCell.FormulaR1C1 = "=((RC[-7]*R1C11)+(RC[-7]))"
Range("K6").Select
Range("K6").Select
' ActiveWorkbook.Save 'enregistrer les modifications
' ActiveWorkbook.Close 'Fermer
End Sub
Sub CopierFormuleH()
[I6].Formula = "=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6:I" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleI()
[J6].Formula = "=RC[-1]*0.34"
Range("J6:J" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleK()
[K6].Formula = "=((RC[-7]*R[-5]C)+(RC[-7]))"
Range("K6:K" & [A65536].End(xlUp).Row).FillDown
End Sub
'Sub Taux_Revalorisation()
'Dim TauxRevalo As Double
' TauxRevalo = ThisWorbooks.Sheets("Feuil1").[J9]
'Range("J9").Select
'TauxRevalo = Cells(9, 10)
' MsgBox TauxRevalo
'End Sub
30 nov. 2022 à 12:22
Merci de tenir compte de ceci quand tu partages du code: https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code
"cela ne fonctionne pas": as-tu un message d'erreur?
as-tu essayé d'éxécuter le code en pas à pas?
30 nov. 2022 à 14:13
1- je ne sais pas comment écrire le code pour qu'il réponde à mon problème
2- je ne sais pas où placer le code dans toutes ces macros
30 nov. 2022 à 15:31
Je vois que tu as écrit "ThisWorbooks" au lieu de "ThisWorkbook".
30 nov. 2022 à 16:48
J'ai corrigé mon erreur mais j'ai toujours "Erreur 424 Objet requis"
30 nov. 2022 à 19:08
Je suis curieux de vois le code adapté. Merci de le partager comme expliqué ici: https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code
7 déc. 2022 à 17:47
La procédure
1- j'ouvre le fichier "Lanceur-macro-Revalorisation" Feuil1
2- je renseigne la cellule J9
3- je lance la macro via le bouton
4- A chaque boucle un fichier est mis en forme selon la macro "Sub RevalorisationCotisation()" Pour chaque fichier traité je veux renseigner la cellule K1 de la valeur saisie en J9 du fichier "Lanceur-macro-Revalorisation"
Et cela ne fonctionne pas
Merci de votre aide
Ce n'est pas moi qui est écrit les trois macros ci-dessous, je les aies copiées sur internet et adaptées à mes besoins
Public Sub repertoire(), Private Function FLoadNomDuREP et Private Sub BoucleDeTraitement()
Public Chemin, Fich As String, ReponseMsgBox As Variant
' .
'routine d'appel depuis le bouton sur feuille
' .
Public Sub repertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xlsx du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
' Taux_Revalorisation
BoucleDeTraitement ' appel la routine de traitement des fichiers
MsgBox "Traitement terminé !", vbInformation
Else
MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub
' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
REP = objFolder.Items.Item.Path
If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function
Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""
Workbooks.Open Chemin & Fich
RevalorisationCotisation
'traduction_données_brutes
ActiveWorkbook.Close True
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub RevalorisationCotisation()
Dim repertoire As String
Application.ScreenUpdating = True
Rows("1:1").Select
Range("B1").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A4").Select
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("B2:C2").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Range("D2").Activate
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' renseigner valeur revalorisation
' au lieu de l'écrire en dur dans la macro, je souhaite récupérer la valeur saisie
'dans le fichier "lanceur macro revalorisation"
Range("K1").Select
ActiveCell.FormulaR1C1 = "25%"
Selection.NumberFormat = "0.00"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("C3").Select
ActiveCell.FormulaR1C1 = "Date adhésion"
Range("D3").Select
ActiveCell.FormulaR1C1 = "Cotisation actuelle"
Range("E3").Select
ActiveCell.FormulaR1C1 = "% d'ancienneté"
Range("F3").Select
ActiveCell.FormulaR1C1 = "Coefficient"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Autres primes"
Range("H3").Select
ActiveCell.FormulaR1C1 = "Temps de travail"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Montant cotisation"
Range("J3").Select
ActiveCell.FormulaR1C1 = "Après déduction fiscale"
Range("K3").Select
ActiveCell.FormulaR1C1 = "Cotisation proposée par le BN"
Range("A3:K3").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.Font.Bold = True
End With
Range("B3").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.NumberFormat = "0%"
Columns("H:H").Select
Selection.NumberFormat = "0%"
Range("A3").Select
ActiveCell.FormulaR1C1 = "Valeur du point 100 au 01 décembre de cette année :"
Range("E3").Select
Selection.NumberFormat = "0.000"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Nbre de salaires annuels :"
Range("B1:H1").Select
Selection.Merge
Range("B1:H1").Select
ActiveCell.FormulaR1C1 = "REVALORISATION DES COTISATIONS"
Range("B1:H1").Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
With Selection.Font
.Name = "Calibri"
.Size = 16
End With
Range("A3:J3").Select
With Selection
Selection.Font.Bold = True
End With
Range("A5:K5").Select
Range("K3").Activate
Selection.Font.Bold = True
Range("I3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("E3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
End With
Range("I6").Select
ActiveCell.FormulaR1C1 = _
"=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6").Select
Selection.NumberFormat = "0.00"
Range("J6").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*0.34"
Range("J6").Select
Selection.NumberFormat = "0.00"
Range("K6").Select
Selection.NumberFormat = "0.00"
Range("I6").Select
CopierFormuleH
Range("J6").Select
CopierFormuleI
Range("K6").Select
CopierFormuleK
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Tableau4"
Range("D:E,G:K").Select
Range("G2").Activate
Selection.ColumnWidth = 12
Range("A5:K5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("H6").Select
ActiveCell.FormulaR1C1 = "100%"
Range("H6:H" & [A65536].End(xlUp).Row).FillDown
'Range("H6:H15").Select
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 14.5
Range("K6").Select
ActiveCell.FormulaR1C1 = "=((RC[-7]*R1C11)+(RC[-7]))"
Range("K6").Select
Range("K6").Select
' ActiveWorkbook.Save 'enregistrer les modifications
' ActiveWorkbook.Close 'Fermer
End Sub
Sub CopierFormuleH()
[I6].Formula = "=(((((((RC[-3]*R3C5)*R3C9)+((((RC[-3]*R3C5)*R3C9)*RC[-4])+RC[-2])))*0.77)*0.0085)/12)*RC[-1]"
Range("I6:I" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleI()
[J6].Formula = "=RC[-1]*0.34"
Range("J6:J" & [A65536].End(xlUp).Row).FillDown
End Sub
Sub CopierFormuleK()
[K6].Formula = "=((RC[-7]*R[-5]C)+(RC[-7]))"
Range("K6:K" & [A65536].End(xlUp).Row).FillDown
End Sub
'Sub Taux_Revalorisation()
'Dim TauxRevalo As Double
' TauxRevalo = ThisWorbooks.Sheets("Feuil1").[J9]
'Range("J9").Select
'TauxRevalo = Cells(9, 10)
' MsgBox TauxRevalo
'End Sub
7 déc. 2022 à 18:11
L'erreur se produit à quelle ligne de code?