Problème de variable Modif macro?
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
Bonjour
Tu devrais joindre ton fichier...
Bye !
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
Bonjour,
Feuilles = Array("CURE_" & MEDICAMENT)
à quel endroit MEDICAMENT est-il défini ?
Là il n'a aucune valeur
eric
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
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
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 ?
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
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
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