Autres [RÉSOLU] Code macro à modifier ou pas

[un internaute]

Bonjour le forum,
Dans la macro Posologie j'ai la macro ci-dessous

Option Explicit

Public NBPriseJour As Integer
Public NbJour As Integer
Public Posologie As Integer

Public Const MEDICAMENT As String = "CALCIDOSE"

Sub InitCALCIDOSE()
  Posologie = 1
  NBPriseJour = 1
  NbJour = 30
End Sub

Dans la macro ci-dessous ça met bien MEDICAMENT

Option Explicit
 
Dim DbClic As Boolean
 
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("L:N").Hidden = Not Columns("L:N").Hidden
      Cancel = True
  End If
End Sub

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


  If Target.Address = "$A$3" Then
 
    Run "Init" & MEDICAMENT
    
    If Range("C3") <> "CALCIDOSE" 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("F" & Rows.Count).End(xlUp).Row + 1
    Else
      LgEnCours = Range("F" & Rows.Count).End(xlUp).Row
    End If
    
    If Not IsDate(Target) Then
      Target = ""
    End If
    
    If Target = "" Then
      Range("A3:D102").ClearContents
      Range("N3:N102").ClearContents
    Else
        Run "Init" & MEDICAMENT

      With Sheets("RESULTAT_ANALYSE")
        Ligne = Application.Match(Range("A3"), .Columns("F"), 1)
        If Not IsError(Ligne) Then
          Range("D3") = .Range("B" & Ligne)
        End If
      End With
    
      Range("C3") = "CALCIDOSE"
      Range("B3") = Posologie
      Range("F" & LgEnCours) = NBPriseJour
      
      ' Début Partie Modifié le 24/01/2020
      Range("J" & LgEnCours) = Range("A3")
      Range("H" & 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("N3")
      With Range("N3:N102")
        .NumberFormat = "m/d/yyyy"
        .FormatConditions.Delete
                .Interior.ColorIndex = 35
          With .Font
                .Name = "Arial"
                .Size = 10
                .ColorIndex = 5
          End With

      End With
      With Range("O3:O102")
        .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("H" & Rows.Count).End(xlUp).Row
      Range("K" & LgEnCours) = DateAdd("d", NbJour - 1, Range("J" & Ligne))
      Range("I" & LgEnCours) = Application.Proper(Format(DateAdd("d", NbJour - 1, Range("J" & Ligne)), "dddd dd mmmm yyyy"))
      
      ' Fin Partie Modifié le 24/01/2020
    End If
  End If
 
  Init_Feuille
  Range("A3").Select
  Application.EnableEvents = True
  End Sub

Sauf que dans la feuille RESULTAT_ANALYSE où ça met cALCIDOSE
Logique ou pas?
Si pas logique ou placer le code ci-dessous

Run "Init" & MEDICAMENT

Merci pour vos éventuels retours
Cordialement

 

[ChTi160]

Bonsoir un internaute
Pas évident de comprendre ces procédures sans fichier.
Pourquoi mettre
Run "Init" & MEDICAMENT
Plutôt que Run InitCALCIDOSE ?
Y'a sûrement une raison que j'entrevois mais bon!
Un petit fichier ?
Jean marie

 

[ChTi160]

Re tu pourrais aussi
Crée ,remplacer la les procédures Initxxxxxxx
Par une procédure

Sub Init(Str)
Select case Str
Case "CALCIDOSE"
  Posologie = 1
  NBPriseJour = 1
  NbJour = 30
 Case xxxx
  Posologie = 10
  NBPriseJour = 1
  NbJour = 10
 Case  yyyy
Etc
End Select
End Sub

Pour ce qui est de l'emplacement où est collé le texte il apparaît que "RESULTAT_ANALYSE" soit la seule référence à une feuille.
De mon téléphone lol
Jean marie

 

[ChTi160]

Re
Mettre

Run "Init" & MEDICAMENT
'×××××××××××
      Range("C3") = "CALCIDOSE"
      Range("B3") = Posologie
      Range("F" & LgEnCours) = NBPriseJour
'×××××××××××
      With Sheets("RESULTAT_ANALYSE")
        Ligne = Application.Match(Range("A3"), .Columns("F"), 1)
        If Not IsError(Ligne) Then
          Range("D3") = .Range("B" & Ligne)
        End If
      End With

Non testé pas de fichier lol
Jean marie