Impossible de mettre une formule dans une cellule en VBA
Bonjour,
J'espère être dans le bon forum.
Je souhaite mettre une formule dans une cellule Excel en utilisant du code Vba.
Voici l'extrait de mon code :
...
...
With Worksheets(Tab_Annee(i)) ' Tab_Annee(i) contient par exemple 04-2019 (mois et année)
.Activate
End With
...
Saut_Ligne=3
...
...
For i = 0 to max
...
...
Select Case i
Case Is = 0 ' premier mois
Case Is = Max_Feuilles - 1 ' dernier mois
Case Else ' les autres mois
For l = Prem_Ligne To Ligne_Max
chaine1 = "='" & CStr(Tab_Annee(i - 1)) & "'!" & CStr(ConvertToLetter(DDay_MoisPreced)) & l
Worksheets(Tab_Annee(i)).Cells(AlphaColToNum(DDay_MoisEnCours), l).Formula = chaine1
l = l + (Saut_Ligne - 1)
Next l
End Select
...
...
Next i
Lorsque je mets un espion sur Worksheets(Tab_Annee(i)).Cells(AlphaColToNum(DDay_MoisEnCours), l).Formula, cela est bien égale à chaine1 (enfin le contenu) mais la formule ne s'inscrit jamais dans la cellule. J'y ai passé l'après-midi...Pour information chaine1 prends une valeur comme suit : "='04-2019'!G7"
MERCI de votre aide.
Je vous donne les fonctions utilisées pour info :
Function AlphaColToNum(Col) As Long
AlphaColToNum = Range(Col & 1).Column
End Function
Function ConvertToLetter(iCol As Variant) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Bonjour,
sans grande conviction :
Worksheets(Tab_Annee(i)).Cells(AlphaColToNum(DDay_MoisEnCours), l).Formula = "=" & chaine1
En supprimant la ligne : chaine1 = "='" & CStr(Tab_Annee(i - 1)) & "'!" & CStr(ConvertToLetter(DDay_MoisPreced)) & l
@ bientôt
LouReeD
Bonjour LouReed,
Merci...mais c'est exactement pareil...Je tourne en rond...
Slt jpclutier,
il nous faut le code complet ou mieux le fichier
Merci d'avance
Le voici...je craignais de trop encombrer avec l'ensemble du fichier...
J'ai mis un commentaire juste au-dessus de la ligne qui 'pose un souci'...
Merci.
Bonjour,
Si tu veux écrire une formule dans une cellule, il faut faire référence à la cellule
ex: Cellule.formula=
Dans ton cas tu fais référence à un onglet (Worksheet).
Exemple pour écrire une formule dans la cellule A16.
(Fonction SOMME.SI des cellule A4 à A15 si valeur supérieure à 10)
Range("A16").FormulaR1C1 = "=SUMIF(R[-12]C:R[-1]C,"">10"")"
ou encore
Cells(16,1).FormulaR1C1 = "=SUMIF(R[-12]C:R[-1]C,"">10"")"
ou encore en faisant référence à un onglet Worksheet (ici nommé Feuil2)
Worksheets("Feuil2").Cells(16,1).FormulaR1C1 = "=SUMIF(R[-12]C:R[-1]C,"">10"")"
Par ailleurs je n'ai pas bien compris ton utilisation de la structure "SELECT...Case....END SELECT"
Si tu pouvais joindre un fichier d'exemple ce serait bien !
Cordialement,
Slt,
je viens de faire un test
et la formule ='04-2019'!AL7 s'insére en premier dans la céllule G39 de l'onglet 05-2019
donc le code fonctionne, c'est peut être pas la bonne céllule où la formule doit apparaître?
En regardant ton code avec le débogueur ligne à ligne, je vois déjà un problème de syntaxe dans les structures With...End With
Version corrigée
' Recherche Année en cours
With Worksheets(Feuille_Source)
Annee_EnCours = .Range("D1").Value
End With
' Recherche nombre d'agents
With Worksheets(Feuille_Data)
Nbre_Agent = .Range("D2").Value
FirstMonth = .Range("D5").Value
Prem_Ligne = .Range("D6").Value
Saut_Ligne = .Range("D7").Value
End With
Ton code:
' Recherche Année en cours
With Worksheets(Feuille_Source)
.Activate
Annee_EnCours = Range("D1").Value
End With
' Recherche nombre d'agents
With Worksheets(Feuille_Data)
.Activate
Nbre_Agent = Range("D2").Value
FirstMonth = Range("D5").Value
Prem_Ligne = Range("D6").Value
Saut_Ligne = Range("D7").Value
End With
Bonjour GNIN,
Merci de t'intéresser au sujet.
Je ne peux pas faire R1C1 car cellules d'une autre feuille...On peut enlever le WorkSheet ...
Pour le SELECT ... End SELECT il me faudra différencier le premier mois, le dernier mois et les autres mois....mais ce n'est pas terminé.
J'ai déjà joint le fichier.
Merci GNIN,
En fait j'ai interverti ligne et colonne. Merci !
Autres problèmes:
Tu fais appel à la fonction Verif_Cal en passant le paramètre Feuille_Active ainsi que le tableau Tab_Annee
Sauf erreur, la variable Feuille_Active n'est pas définie (Vide)
' Génération des feuilles pour l'année
retour = Verif_Cal(Feuille_Active, Tab_Annee)
Concernant la fonction Verif_Cal
Private Function Verif_Cal(feuille, tableau) As Variant
For i = LBound(tableau) To UBound(tableau)
For j = 1 To Sheets.Count
If Sheets(j).Name = tableau(i) Then
Verif_Cal = Sheets(j).Name
End If
Next j
Next i
End Function
La variable de réception "Feuille" n'est pas utilisée (??)
De plus tu pars dans deux boucles imbriquées pour finalement renvoyer le nom de la dernière feuille traitée (Verif_Cal = Sheets(j).Name).
Je ne vois pas vraiment à quoi sert cette fonction et j'avoue avoir quelques doutes sur le concept.
C'est pour vérifier quoi exactement ?
A+
Bonjour,
J'ai un peu modifié ton code afin d'éviter les différents (nombreux) "plantages" que j'ai eu avec la version d'origine.
Je te communique le début de la procédure modifiée (Procédure nommée TEST). Je n'ai pas eu le temps de regarder le reste.
C'est la partie qui crée supprime et/ou crée les onglets selon le cas.
J'ai placé des fonctions perso qui simplifient le code principal (DupliquerFeuille, FeuilleExiste, SupprimerFeuille + Verif_Cal modifiée ).
Sub TEST()
Dim Tab_Annee(14) As Variant, Annee_EnCours, Feuille_Active, Feuille_Source, Feuille_Data, Max_Feuilles, retour As Variant
Dim Nom, Message As String, i, j, k, l As Byte, Verif, FFlag As Boolean
Dim plage1, plage2, FirstDay, DDay, DDay_MoisEnCours, FirstMonth, Val_Test, Premiere_Colonne, Colonne_EnCours, Lettres_Jour As Variant
Dim Nbre_Agent, Prem_Ligne, Ligne_Max, Saut_Ligne, Nbre_Jours, NbreMax_Jours, Largeur, DDay_MoisPreced, Seuil, Seuil2, Ligne_Jour As Integer
Dim chaine1 As String
Feuille_Source = "Trame"
Feuille_Data = "Donnees"
Max_Feuilles = 14
Seuil = 5
Ligne_Jour = 3
NbreMax_Jours = 42
Premiere_Colonne = "A"
chaine1 = ""
' Recherche Année en cours
With Worksheets(Feuille_Source)
Annee_EnCours = .Range("D1").Value
End With
' Recherche nombre d'agents
With Worksheets(Feuille_Data)
Nbre_Agent = .Range("D2").Value
FirstMonth = .Range("D5").Value
Prem_Ligne = .Range("D6").Value
Saut_Ligne = .Range("D7").Value
End With
Ligne_Max = (Nbre_Agent * Saut_Ligne) + Prem_Ligne
plage1 = ("A1:BE" & Ligne_Max)
plage2 = "A:BE"
' Init Tableau des feuilles de l'année
For i = 0 To Max_Feuilles - 1
Select Case i
Case 0
Tab_Annee(i) = "04-" & Annee_EnCours
Case 1 To 5
Tab_Annee(i) = "0" & i + 4 & "-" & Annee_EnCours
Case 6 To 8
Tab_Annee(i) = i + 4 & "-" & Annee_EnCours
Case 9 To 13
Tab_Annee(i) = "0" & (i - 8) & "-" & Annee_EnCours + 1
End Select
Next i
' Génération des feuilles pour l'année
retour = Verif_Cal(Tab_Annee)
If retour <> "" Then
Message = "Feuille " & retour & " existante. Calendrier déjà généré. Voulez-vous écraser et regénérer le calendrier ?"
If MsgBox(Message, 1) = 1 Then
'Suppression des onglets
Application.DisplayAlerts = False
For i = 0 To Max_Feuilles - 1
SupprimerFeuille (CStr(Tab_Annee(i)))
Next i
' Réactivation des alertes
Application.DisplayAlerts = True
'Création des onglets
For i = 0 To Max_Feuilles - 1
DupliquerFeuille "Trame", CStr(Tab_Annee(i))
Next i
End If
Else
For i = 0 To Max_Feuilles - 1
DupliquerFeuille "Trame", CStr(Tab_Annee(i))
Next i
End If
retour = ""
End Sub
Sub DupliquerFeuille(NF As String, NN As String)
If Not FeuilleExiste(NN) Then
Sheets(NF).Select
Sheets(NF).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = NN
End If
End Sub
Sub SupprimerFeuille(NF As String)
If FeuilleExiste(NF) Then
Sheets(NF).Delete
End If
End Sub
Function FeuilleExiste(NomFeuille As String) As Boolean
Dim F As Worksheet
FeuilleExiste = False
For Each F In Sheets
If LCase(F.Name) = LCase(NomFeuille) Then
FeuilleExiste = True
Exit For
End If
Next
End Function
Private Function Verif_Cal(tableau) As Variant
Verif_Cal = ""
For i = LBound(tableau) To UBound(tableau)
For j = 1 To Sheets.Count
If Sheets(j).Name = tableau(i) Then
Verif_Cal = Sheets(j).Name
End If
Next j
Next i
End Function
En espérant t'avoir mis sur la voie,
Bon courage pour le reste,