Sujet Précédent Sujet Suivant

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

Fermé
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022 - 22 nov. 2022 à 08:50
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 - 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

A voir également:

10 réponses

Réponse 1 / 10
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
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
0
Réponse 2 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
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
0
Réponse 3 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
22 nov. 2022 à 15:42

basé sur la valeur saisie
0
Réponse 4 / 10
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
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?
0

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

Posez votre question
Réponse 5 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
23 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
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
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]
0
Réponse 6 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
23 nov. 2022 à 13:32

Cela génère  une erreur 404 Objet requis
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
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

0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
30 nov. 2022 à 12:47

as-tu bien écrit "thisworkbook"?

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

0
Réponse 7 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
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
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
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?

0
Réponse 8 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
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
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
30 nov. 2022 à 15:31

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

0
Réponse 9 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
30 nov. 2022 à 16:48

J'ai corrigé mon erreur mais j'ai toujours "Erreur 424 Objet requis"
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
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

0
Réponse 10 / 10
roulchal Messages postés 9 Date d'inscription mardi 22 novembre 2022 Statut Membre Dernière intervention 7 décembre 2022
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
0
yg_be Messages postés 22732 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 28 avril 2024 1 477
7 déc. 2022 à 18:11

L'erreur se produit à quelle ligne de code?

0