Pinwand per VBA

Danke für Eure Hilfe ...
Zum Erstellen monatlicher Dienstpläne möchte ich eine Pinwand entwerfen,
auf der Stundenblöcke verschoben werden, und so Dienstfolgen ermittelt werden.
Eine Zelle beinhaltet die Zahl der Stunden 8 für 8h und eine farbige Formatierung
für die Tageszeit, wann die Dienstzeit erfolgt, Morgens, Mittags Abends.
Meine konkrete Frage:
1. Ich klicke ein beliebiges Feld an
2. Der Zwichenspeicher ist leer, darum wird der Zellwert inkl. Formatierung ausgeschnitten
3. Ich klicke eine nächste Zelle an
4. Der Zwischenspeicher ist voll - der Wert und Formatierung werden eingefügt.
5. Klicke ich auf eine Zelle in Verbindung mit STRG bei leerem Zwischenspeicher, wird die Zelle kopiert
6. Einfügen analog wie oben
Am Ende jeder Zeile werden die Stunden summiert. Die Zellbezüge sollen für jedes Feld erhalten bleiben.
Ich erhoffe mir eine praktische Pinnwand, um die vielen Ansprüche der Kollengen
schnell und vergleichbar darzustellen. Vorab Danke.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Oliver,
folgendes Makro, direkt in das Blatt kopiert, erledigt Punkt 1-4. Allerdings musst du schon doppelclicken, irgendwoher muss Excel ja wissen dass du ein Makro ausführen willst :-)
Die Formatierungen würd ich an deiner Stelle mit "bedingte Formatierung" lösen, statt mit Zellformatierung. Ob das unter xl2007 schon mit mehr als 3 Varianten geht weiss ich nicht, unter xl2010+ auf jedem Fall.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
'der Zwischenspeicher
Dim Zwischenspeicher As Range
Set Zwischenspeicher = Range("D34")
'hier darf EINGETRAGEN werden
'TIP: Zellen markieren, dabei Makrorekorder laufen lassen, um die lange RANGE-Anweisung zu  _
bekommen
Dim rLaubt As Range
Set rLaubt = Union(Range("D23:J23,D9:J9,L9:R9,T9:Z9,AB9:AH9,AB11:AH11,T11:Z11,L11:R11,D11:J11, _
D13:J13,M13:R13,L13,T13:Z13,AB13:AH13,AB15:AH15,T15:Z15,L15:R15,D15:J15,D17:J17,L17:R17,T17:Z17,AB17:AH17,AB19:AH19,T19:Z19,L19:R19,D19:J19,D21:J21,L21:R21,T21:Z21,AB21:AH21,AB23:AH23"), Range("L23:R23"))
'hier darf ausgewählt werden
Dim rAuswahl As Range
Set rAuswahl = Range("D27,D29,D31,L27,L29,L31,T27,T29,T31,AB27,AB29,AB31")
Cancel = True
'Falls Auswahl, in Zwischenspeicher übertragen
If Not Intersect(Target, rAuswahl) Is Nothing Then
Target.Copy
Zwischenspeicher.PasteSpecial
Application.CutCopyMode = False
End If
'Falls Eintrag, aus Zwischenspeicher eintragen
If Not Intersect(Target, rLaubt) Is Nothing Then
If Not Zwischenspeicher.Value = "" Then
Zwischenspeicher.Copy
Target.PasteSpecial
Application.CutCopyMode = False
'Zwischenspeicher löschen
With Zwischenspeicher
.ClearContents
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End If
End If
Application.ScreenUpdating = True
End Sub

Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread