per Hyperlink Zelle in eine andere Zelle übertragen

[Serdinho]

Guten morgen zusammen :)

Ich habe folgende Frage an euch Experten:
Ich würde gerne per Hyperlink eine bestimmte Zelle in eine andere übertragen (siehe Anhang).
Wenn ich zb in B11 klicke und dann oben auf "Hyperlink Button" U3, dann soll er mir in B11 die Farbe + die Ziffer 1 wiedergeben.
Die Liste soll wiedergeben, welcher Mitarbeiter wo gearbeitet hat. Vor allem wie lange er im jeweiligen Bereich war (1=Tag, halben Tag, etc..).
Am Ende soll er in Zelle EA bis EE alles summieren.
Ich weiß, ich könnte auch die ganze Zeit copy/paste machen, jedoch möchte ich das gerne so haben.

Über eine Lösung würde ich mich sehr freuen.

mfg

[Rabe]

Hi,

dann mache Dir anstatt der farbigen Zellen farbige Buttons, die Dir per VBA-Makro die entsprechende Zahl und Farbe in die aktuelle Zelle schreiben.

[Serdinho]

Hallo Rabe,

könntest du mir sagen/zeigen wie das geht? :/

[Rabe]

Hi,

hier Deine Datei zurück mit den Buttons und Makros für Logiflor.

1. Zuerst ein Makro aufgezeichnet zur Eintragung der Zahl und der Farbe in die aktuelle Zelle. Dann Zuweisung des Makros an den entsprechenden Button.
   
2. Kopieren des Makros mit neuem Namen für den zweiten Button. Dann Zuweisung des Makros an den zweiten Button.
   
3. Makro-Aufzeichnung starten, Einfärbung der Zelle H2, beenden der Makro-Aufzeichnung. Dadurch Ermittlung der Nummer für die jeweilige Farbe. Diese Farbnummer habe ich dann in das kopierte Makro an der passenden Stelle eingefügt.
   
4. usw. für die restlichen Buttons
   

Hier die Makros:

Option Explicit

Sub Logi100()
  ' 
  ' Logi 1 Makro 
  ' 
  
  ' 
  With ActiveCell
     .FormulaR1C1 = "1"
     With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 682978
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
  End With
End Sub

Sub Logi75()
  ' 
  ' Logi 0,75 Makro 
  ' 
  
  ' 
  With ActiveCell
     .FormulaR1C1 = "0,75"
     With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 4626167
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
  End With
End Sub

Sub Logi50()
  ' 
  ' Logi 0,5 Makro 
  ' 
  
  ' 
  With ActiveCell
     .FormulaR1C1 = "0,5"
     With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 9420794
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
  End With
End Sub

Sub Logi25()
  ' 
  ' Logi 0,25 Makro 
  ' 
  
  ' 
  With ActiveCell
     .FormulaR1C1 = "0,25"
     With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 11851260
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
  End With
End Sub

'hier müssen nun die Makros für die restlichen Farben und Zahlen einkopiert werden. 

und hier Deine Datei:
  Übersicht Fremdpersonal 2018 - Rabe.xlsb (Größe: 52,32 KB / Downloads: 1)

[Serdinho]

Hallo Rabe,

erstmal danke, hast mir super geholfen.


Schönes We!

[Serdinho]

Hallo,

ich habe die Liste soweit bearbeitet.

Habe jedoch noch eine Frage. Ich bekomme am Ende die Summierung nicht hin. Optimal wäre, wenn anstatt wie bei N12 nicht die Zahl sondern der Buchstabe (L, W, C, etc...) stehen würde. Ist es möglich, dass Excel dann via Farbe die Summierung übernimmt? (Siehe Anhang)

[Rabe]

Hi,

und woher weiß Excel, ob bei den Kategorieren (L - K - W - C - F) nun 1 - 0,75 - 0,5 oder 0,25 zu zählen ist? Nur aufgrund der Farbhelligkeit ?

Dann könntest Du per VBA-Makro eine Schleife über die ganze Zeile laufen lassen, die direkt die Farben zählt und mit den entsprechenden Faktoren multipliziert.

Vierlleicht kann Dir hier ein VBA-Experte ein Makro schreiben.

[Steffl]

Auch Hallo,

anstatt für jeden Button ein Makro zu schreiben, in denen zum Teil der gleiche Code steht, könntest Du ein Makro nehmen, welches entsprechend dann auswählt. Weise dieses Makro allen Buttons zu.

Code:

Sub prcFarben()
   Dim vntFarben As Variant
   Dim vntTheme As Variant
   Dim vntWert As Variant
  
   vntWert = Array(1, 0.75, 0.5, 0.25)
   vntFarben = Array(-0.249977111117893, 0, 0.399975585192419, 0.599993896298105)
  
   Select Case Left(ActiveSheet.Shapes(Application.Caller).DrawingObject.Characters.Text, 1)
      Case "F"
         vntTheme = xlThemeColorAccent2
      Case "C"
         vntTheme = xlThemeColorAccent3
      Case "L"
         vntTheme = xlThemeColorAccent1
      Case "W"
         vntTheme = xlThemeColorAccent4
      Case "K"
         vntTheme = xlThemeColorAccent5
   End Select
  
   With ActiveCell
      .Value = Left(ActiveSheet.Shapes(Application.Caller).DrawingObject.Characters.Text, 1)
      With .Interior
         .PatternColorIndex = xlAutomatic
         .ThemeColor = vntTheme
         .TintAndShade = vntFarben(WorksheetFunction.Match _
          (CDbl(Mid(ActiveSheet.Shapes(Application.Caller).DrawingObject.Characters.Text, 2)), vntWert, 0) - 1)
         .PatternTintAndShade = 0
      End With
   End With
End Sub

Wo findet in deiner Datei eigentlich die Summierung statt?

[Rabe]

Hi Stefan,

so viel ich sehe, soll in den Spalten EA bis EF summiert werden.

[Steffl]

Hallo Ralf,

danke für die Info (soweit hinten habe ich nicht geschaut).