Répondre à la discussion

Message

<blockquote data-quote="un internaute" data-source="post: 20397233" data-attributes="member: 196677">Bonjour le forumDans la macro ci-dessous je voudrais faire une copy de la colonne dates (colonne A) qui sont en police Arial 12 en Colonne M (voir macro) mais Arial 10 avec couleur de fond vert clair (couleur 35) et police 10 bleu (couleur 5)Merci pour vos éventuels retoursCordialementPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)&nbsp; If Target.Address = &quot;$A$3&quot; Then&nbsp; &nbsp; InitBEROCCA&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; 'Module posologie&nbsp; &nbsp; Target = IIf(Target.Value = Application.Proper(Format(Date, &quot;dddd dd mmmm yyyy&quot;)), &quot;&quot;, Date): Cancel = True&nbsp; ElseIf Target.Address = &quot;$A$2&quot; Then&nbsp; &nbsp; &nbsp; Columns(&quot;K:M&quot;).Hidden = Not Columns(&quot;K:M&quot;).Hidden&nbsp; &nbsp; &nbsp; Cancel = True&nbsp; End IfEnd SubPrivate Sub Worksheet_Change(ByVal Target As Range)Dim LigneDim NbInr As Integer, NbLigne As LongDim Cel As Range&nbsp; If Target.Address = &quot;$A$3&quot; Then&nbsp; &nbsp; Application.ScreenUpdating = False&nbsp; &nbsp; Application.EnableEvents = False&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If Target = &quot;&quot; Then&nbsp; &nbsp; &nbsp; Range(&quot;A3:C102&quot;).ClearContents&nbsp; &nbsp; &nbsp; Ligne = Application.Max(3, Range(&quot;E&quot; &amp; Rows.Count).End(xlUp).Row)&nbsp; &nbsp; &nbsp; If Range(&quot;H&quot; &amp; Ligne) = &quot;&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; Range(&quot;E&quot; &amp; Ligne &amp; &quot;,G&quot; &amp; Ligne &amp; &quot;:J&quot; &amp; Ligne).ClearContents&nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; Range(&quot;C3&quot;) = &quot;TOTO&quot;&nbsp; &nbsp; &nbsp; Range(&quot;B3&quot;) = Posologie&nbsp; &nbsp; &nbsp; Range(&quot;E&quot; &amp; Rows.Count).End(xlUp).Offset(1, 0) = NBPriseJour&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ' Début Partie Modifié le 24/01/2020&nbsp; &nbsp; &nbsp; Range(&quot;I&quot; &amp; Rows.Count).End(xlUp).Offset(1, 0) = Range(&quot;A&quot; &amp; Target.Row)&nbsp; &nbsp; &nbsp; Range(&quot;G&quot; &amp; Rows.Count).End(xlUp).Offset(1, 0) = Application.Proper(Format(Range(&quot;A&quot; &amp; Target.Row), &quot;dddd dd mmmm yyyy&quot;))&nbsp; &nbsp; &nbsp; ' Fin Partie Modifié le 24/01/2020&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Range(&quot;A3&quot;).AutoFill Destination:=Range(&quot;A3:A102&quot;), Type:=xlFillSeries&nbsp; &nbsp; &nbsp; Range(&quot;A3:A102&quot;).Copy Range(&quot;M3&quot;)&nbsp; &nbsp; &nbsp; With Range(&quot;M3:M102&quot;)&nbsp; &nbsp; &nbsp; &nbsp; .NumberFormat = &quot;m/d/yyyy&quot;&nbsp; &nbsp; &nbsp; &nbsp; .FormatConditions.Delete&nbsp; &nbsp; &nbsp; End With&nbsp; &nbsp; &nbsp; With Range(&quot;N3:N102&quot;)&nbsp; &nbsp; &nbsp; &nbsp; .Formula = &quot;=PROPER(TEXT(A3,&quot;&quot;jjjj jj mmmm aaaa&quot;&quot;))&quot;&nbsp; &nbsp; &nbsp; &nbsp; .Copy&nbsp; &nbsp; &nbsp; &nbsp; Range(&quot;A3&quot;).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False&nbsp; &nbsp; &nbsp; &nbsp; .ClearContents&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Application.CutCopyMode = False&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; NbLigne = 99&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; '102 - Target.Row&nbsp; &nbsp; &nbsp; Range(&quot;B3&quot;).AutoFill Destination:=Range(&quot;B3&quot;).Resize(Application.Min(NbJour, NbLigne))&nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &nbsp; &nbsp; &nbsp; ' Début Partie Modifié le 24/01/2020&nbsp; &nbsp; &nbsp; Ligne = Range(&quot;I&quot; &amp; Rows.Count).End(xlUp).Row&nbsp; &nbsp; &nbsp; Range(&quot;H&quot; &amp; Ligne) = Application.Proper(Format(DateAdd(&quot;d&quot;, NbJour - 1, Range(&quot;I&quot; &amp; Ligne)), &quot;dddd dd mmmm yyyy&quot;))&nbsp; &nbsp; &nbsp; Range(&quot;J&quot; &amp; Ligne) = DateAdd(&quot;d&quot;, NbJour - 1, Range(&quot;I&quot; &amp; Ligne))&nbsp; &nbsp; &nbsp; ' Fin Partie Modifié le 24/01/2020&nbsp; &nbsp; End If&nbsp; End If&nbsp; &nbsp; Init_Feuille&nbsp; Range(&quot;A3&quot;).Select&nbsp; Application.EnableEvents = True&nbsp; End Sub</blockquote>

[QUOTE="un internaute, post: 20397233, member: 196677"] Bonjour le forum Dans la macro ci-dessous je voudrais faire une copy de la colonne dates (colonne A) qui sont en police Arial 12 en Colonne M (voir macro) mais Arial 10 avec couleur de fond vert clair (couleur 35) et police 10 bleu (couleur 5) Merci pour vos éventuels retours Cordialement Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$3" Then InitBEROCCA 'Module posologie Target = IIf(Target.Value = Application.Proper(Format(Date, "dddd dd mmmm yyyy")), "", Date): Cancel = True 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 Dim NbInr As Integer, NbLigne As Long Dim Cel As Range If Target.Address = "$A$3" Then Application.ScreenUpdating = False Application.EnableEvents = False If Target = "" Then Range("A3:C102").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") = "TOTO" Range("B3") = Posologie Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = NBPriseJour ' Début Partie Modifié le 24/01/2020 Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & Target.Row) Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = Application.Proper(Format(Range("A" & Target.Row), "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 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" & Ligne) = Application.Proper(Format(DateAdd("d", NbJour - 1, Range("I" & Ligne)), "dddd dd mmmm yyyy")) Range("J" & Ligne) = DateAdd("d", NbJour - 1, Range("I" & Ligne)) ' Fin Partie Modifié le 24/01/2020 End If End If Init_Feuille Range("A3").Select Application.EnableEvents = True End Sub [/QUOTE]

Vérification