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.

7planning-jour.zip (75.14 Ko)

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,

Merci beaucoup !

Rechercher des sujets similaires à "impossible mettre formule vba"