Problème de variable Modif macro?

Le 18/04/2021 à 07:39

Bonjour le forum

Je veux éventuellement changer ce qui fonctionne bien!!!

Dans la macro ci-dessous je voudrais modifier MEDICAMENT par le nom du Médicament = THALAMAG

J'ai essayé mais ça n'aime pas trop!!!

Merci à vous pour vos éventuels retours

Cordialement

Option Explicit

Sub Init_Feuille()
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, Medicaments

  Feuilles = Array("CURE_" & MEDICAMENT)
  Medicaments = Array(MEDICAMENT)
  For I = 0 To 0                           'Mettre For I = 0 To 0 pour feuille unique
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                      'WSheet.Protect UserInterfaceOnly:=True

    For J = 3 To 102                       '3 = Début Ligne 102 = Fin Ligne
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = Medicaments(I)) Or (WSheet.Range("M" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("M" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("M" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("M" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
  Protection Sheets("CURE_" & MEDICAMENT)    'Sheets("CURE-THALAMAG").Protect UserInterfaceOnly:=True

End Sub

Le 18/04/2021 à 08:03

Bonjour

Tu devrais joindre ton fichier...

Bye !

Le 18/04/2021 à 08:30

Bonjour gmb

Je ne peux pas joindre le fichier trop perso mais j'ai fait ça et ça fonctionne mais pas normale quand même.

En faisant EDITION remplacer MEDICAMENT par THALAMAG ça a laissé un s minuscule à THALAMAGs et ça fonctionne.

Merci à toi

Sub Init_Feuille()            'Macro pour Samedi, Dimanche et Jours Fériés. Si on voit en Filigrane des numéros, placer le curseur sur la première ligne et appuyer sur F5
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, THALAMAGs

  Feuilles = Array("CURE_" & THALAMAG)
  THALAMAGs = Array(THALAMAG)
  For I = 0 To 0                           'Mettre For I = 0 To 0 pour feuille unique
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                      'WSheet.Protect UserInterfaceOnly:=True

    For J = 3 To 102                       '3 = Début Ligne 102 = Fin Ligne
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = THALAMAGs(I)) Or (WSheet.Range("M" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("M" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("M" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("M" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
  Protection Sheets("CURE_" & THALAMAG)    'Sheets("CURE-BEROCCA").Protect UserInterfaceOnly:=True

End Sub

Le 18/04/2021 à 08:34

Bonjour,

Feuilles = Array("CURE_" & MEDICAMENT)
à quel endroit MEDICAMENT est-il défini ?
Là il n'a aucune valeur
eric

Le 18/04/2021 à 08:51

Bonjour eriiic

Macros origine

Option Explicit

Dim DbClic As Boolean
Private Sub CommandButton1_Click()
Usf_Annees.Show
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  If Target.Address = "$A$3" Then
    DbClic = True

    Run "Init" & MEDICAMENT                     

    Target = IIf(Target.Value <> "", "", Date): Cancel = True
    DbClic = False
  ElseIf Target.Address = "$A$2" Then
      Columns("K:M").Hidden = Not Columns("K:M").Hidden
      Cancel = True
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne, LgEnCours As Long
Dim NbLigne As Long

  If Target.Address = "$A$3" Then

    Run "Init" & MEDICAMENT                      ' Le 28/01/2021

    If Range("C3") <> MEDICAMENT And DbClic = False Then
      Application.EnableEvents = False
      Target = ""
      Application.EnableEvents = True
      Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    If DbClic = True Then
      LgEnCours = Range("E" & Rows.Count).End(xlUp).Row + 1
    ElseSub Init_Feuille()
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, Medicaments

  Feuilles = Array("CURE_" & MEDICAMENT)
  Medicaments = Array(MEDICAMENT)
  For I = 0 To 0                           'Mettre For I = 0 To 0 pour feuille unique
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                      

    For J = 3 To 102                       '3 = Début Ligne 102 = Fin Ligne
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = Medicaments(I)) Or (WSheet.Range("M" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("M" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("M" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("M" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
  Protection Sheets("CURE_" & MEDICAMENT)  

End Sub

LgEnCours = Range("E" & Rows.Count).End(xlUp).Row End If If Not IsDate(Target) Then Target = "" End If If Target = "" Then Range("A3:C102").ClearContents Range("M3:M102").ClearContents Ligne = Application.Max(3, Range("E" & Rows.Count).End(xlUp).Row) If Range("H" & Ligne) = "" Then Range("E" & Ligne & ",G" & Ligne & ":J" & Ligne).ClearContents End If Else Range("C3") = MEDICAMENT Range("B3") = Posologie Range("E" & LgEnCours) = NbPriseJour ' Début Partie Modifié le 24/01/2020 Range("I" & LgEnCours) = Range("A3") Range("G" & LgEnCours) = Application.Proper(Format(Range("A3"), "dddd dd mmmm yyyy")) ' Fin Partie Modifié le 24/01/2020 Range("A3").AutoFill Destination:=Range("A3:A102"), Type:=xlFillSeries Range("A3:A102").Copy Range("M3") With Range("M3:M102") .NumberFormat = "m/d/yyyy" .FormatConditions.Delete .Interior.ColorIndex = 35 With .Font .Name = "Arial" .Size = 10 .ColorIndex = 5 End With End With With Range("N3:N102") .Formula = "=PROPER(TEXT(A3,""jjjj jj mmmm aaaa""))" .Copy Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False .ClearContents End With Application.CutCopyMode = False NbLigne = 99 '102 - Target.Row Range("B3").AutoFill Destination:=Range("B3").Resize(Application.Min(NbJour, NbLigne)) ' Début Partie Modifié le 24/01/2020 ' Ligne = Range("I" & Rows.Count).End(xlUp).Row Range("H" & LgEnCours) = Application.Proper(Format(DateAdd("d", NbJour - 1, Range("I" & LgEnCours)), "dddd dd mmmm yyyy")) Range("J" & LgEnCours) = DateAdd("d", NbJour - 1, Range("I" & LgEnCours)) ' Fin Partie Modifié le 24/01/2020 End If End If Init_Feuille ' Le 29/01/2021 Range("A3").Select Application.EnableEvents = True End Sub

Option Explicit

Sub Init_Feuille()            
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, Medicaments

  Feuilles = Array("CURE_" & MEDICAMENT)
  Medicaments = Array(MEDICAMENT)
  For I = 0 To 0                           'Mettre For I = 0 To 0 pour feuille unique
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                      'WSheet.Protect UserInterfaceOnly:=True

    For J = 3 To 102                       '3 = Début Ligne 102 = Fin Ligne
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = Medicaments(I)) Or (WSheet.Range("M" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("M" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("M" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("M" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
  Protection Sheets("CURE_" & MEDICAMENT)    

End Sub

Option Explicit

Public NbPriseJour As Integer    'Au delà 255 Jours remplacer Byte par Integer
Public NbJour As Integer      'Au delà 255 Jours remplacer Byte par Integer
Public Posologie As Integer   ' Ajouté le 19/10/2017
Public Const MEDICAMENT As String = "THALAMAG"    ' Ajouté le 28/01/2021

Sub InitTHALAMAG()
  Posologie = 1        '1 Comprimé
  NbPriseJour = 1      '1 = Nb de Fois/Jour
  NbJour = 10          '30 = Durée du traitement en jour
End Sub

Le 18/04/2021 à 08:59

Bonjour à tous

Laissez tomber car ce matin je fais que des conneries

Je reviendrai vers vous plus tard

Et ça ne vaut pas la peine de faire "bosser" le forum pour pas grand chose car j'en ai comme ça 40 fichiers.

Bonne journée à tous et toutes mes excuses

Très cordialement

Le 18/04/2021 à 09:02

Si tu mets un point d'arrêt sur la ligne que je t'ai indiquée, MEDICAMENT a bien la bonne valeur ?

"ça n'aime pas trop!!!" ne veux pas dire grand chose.
Message d'erreur ? Ligne en erreur ? Résultat incorrect ?

Le 18/04/2021 à 09:34

re eriiic

Comme ça c'est bon

Merci à toi

C'est bien du boulot pour pas grand chose. Mais ça ne vaut pas le coup.

Option Explicit

Sub Init_Feuille()            
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, Medicaments

  Feuilles = Array("CURE_" & THALAMAG)
  Medicaments = Array(THALAMAG)
  For I = 0 To 0                           'Mettre For I = 0 To 0 pour feuille unique
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                      'WSheet.Protect UserInterfaceOnly:=True

    For J = 3 To 102                       '3 = Début Ligne 102 = Fin Ligne
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = Medicaments(I)) Or (WSheet.Range("M" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("M" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("M" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("M" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
  Protection Sheets("CURE_" & THALAMAG)    'Sheets("CURE-BEROCCA").Protect UserInterfaceOnly:=True

End Sub

Option Explicit

Public NbPriseJour As Integer
Public NbJour As Integer
Public Posologie As Integer
Public Const THALAMAG As String = "THALAMAG"

Sub InitTHALAMAG()
  Posologie = 1        '1 Comprimé
  NbPriseJour = 1      '1 = Nb de Fois/Jour
  NbJour = 10          '30 = Durée du traitement en jour
End Sub

Le 18/04/2021 à 12:27

Tu as peut-être résolu ton pb mais pour moi tu devrais continuer à chercher le pourquoi.
Tout laisse penser que MEDICAMENT n'a pas la bonne valeur. Ce pb est donc résolu, mais rien ne te dit que ça ne te causera pas d'erreurs ailleurs. Plus difficiles à détecter si c'est juste un résultat faux dans certaines conditions.
eric

Le 20/04/2021 à 07:39

Bonjour eriiic

Eh! oui tu as raison "casse ailleurs". Comme m'avais dit un ancien du forum il y a quelques années : "Lorsque ça fonctionne ne touche plus à rien"

Qu'il avait raison...et toi aussi

Encore merci à toi.

Bonne journée

Cordialement

Rechercher des sujets similaires à "probleme variable modif macro"