Récupérer une donnée pour l'utiliser dans un autre macro

roulchal Messages postés 9 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -

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

10 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     

    Bonjour,

    Evitez les demandes multiples

    Excel vba (commentcamarche.net)

    Montrez le code de votre macro pour que nous puissions vous aider

    0
  2. roulchal Messages postés 9 Statut Membre
     

    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

    0
  3. roulchal Messages postés 9 Statut Membre
     

    basé sur la valeur saisie

    0
  4. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     

    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?

    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. roulchal Messages postés 9 Statut Membre
     

    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

    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      le fichier "Lanceur_macro_Revalorisation", c'est celui dans lequel se trouve la macro? si oui:

      TauxRevalo = thisworkbook.sheets("lenomdelafeuille").[a1]
      0
  7. roulchal Messages postés 9 Statut Membre
     

    Cela génère  une erreur 404 Objet requis

    0
    2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      as-tu bien écrit "thisworkbook"?

      il est aussi utile d'ajouter "option explicit" en début de module.

      0
  8. roulchal Messages postés 9 Statut Membre
     

     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

    0
  9. roulchal Messages postés 9 Statut Membre
     

    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

    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      Je vois que tu as écrit "ThisWorbooks" au lieu de "ThisWorkbook".

      0
  11. roulchal Messages postés 9 Statut Membre
     

    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      L'erreur se produit à quelle ligne de code?

      0

Discussions similaires

Impossible d'utiliser ce numéro de téléphone pour la validat
Marie -
MPMP10 -

1 réponse
Guide du débutant : j'ai un ordinateur pour la première fois
baissaoui -
baissaoui -

0 réponse