Extra kolom invoegen bij sjabloon met macro's

[rojulienne]

Hi allemaal!

Ik heb zo'n donkerbruin vermoeden dat mijn vraag bij doorgewinterde Excel-gebruikers voor gegniffel zal zorgen, maar mij houdt het al een uurtje of wat bezig, tevergeefs.
Om wat orde aan te brengen in mijn wekelijkse planning, wil ik graag gebruikmaken van een sjabloon dat Excel daarvoor beschikbaar heeft. Nu laat dat sjabloon helaas alleen maandag t/m vrijdag zien, terwijl ik ook graag zaterdag en zondag erin zou hebben. Als ik de bestaande dagen kopieer en plak en daarmee zelf de zaterdag en zondag aanmaak, blijven de functies echter niet behouden. Het instellen van een 'taaksoort' (kleur) werkt dan niet meer.

Iemand hiervoor een oplossing?

 

[SjonR]

werkt dit zo naar behoren?

 

[rojulienne]

Jazeker! Bedankt voor de snelle reactie & oplossing!

 

[VenA]

Waarom zoveel ingewikkelds? Alles kan je met 1 dubbelklik procedure ondervangen.

 

[HSV]

Activesheet gebruiken in een Doubleclick lijkt me overbodig.

or .column = 1

'.Column' zal altijd 2 opleveren waar je ook maar klikt in het bestand.

Blijf binnen de databodyrange met target dan maakt het niet uit waar het Listobject zich bevindt.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Dim t As Long, ar
  With ListObjects(1)
   If Intersect(Target, .DataBodyRange) Is Nothing Then Exit Sub 'Or .Column = 1
     Cancel = True
    Select Case .ListColumns(Cells(.HeaderRowRange.Row, Target.Column).Value).Index Mod 2
      Case 0
        If Target <> "" Then Target.Font.Strikethrough = Not Target.Font.Strikethrough
      Case 1
        If Target.Offset(, -1) <> "" Then
          ar = Array(5061316, 2210034, 9466910, 15921906)
          t = Application.Match(Target.Interior.Color, ar, 0)
            If t = 4 Then
             Target.Interior.Color = ar(0)
            Else
             Target.Interior.Color = ar(t)
            End If
        End If
     End Select
  End With
End Sub

 

[snb]

Of ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.ListObject Is Nothing Then Exit Sub
  
  Cancel = True
  Select Case Target.Column Mod 2
  Case 1
    If Target <> "" Then Target.Font.Strikethrough = Not Target.Font.Strikethrough
  Case 0
    ar = Array(5061316, 2210034, 9466910, 15921906)
    If Target.Offset(, -1) <> "" Then Target.Interior.Color = ar(Application.Match(Target.Interior.Color, ar, 0) Mod 4)
  End Select
End Sub