Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zellmotiffarbe als RGB-Wert auslesen

Betrifft: Zellmotiffarbe als RGB-Wert auslesen von: HartmutM
Geschrieben am: 21.08.2004 19:32:50

Guten Abend,
Ich möchte die RGB-Werte der Zellfarbe (Hintergrund, Motif) auslesen. Hier im Forum fand ich dazu ein Makro, das das Ergebnis als Message-Box ausgibt. Ich möchte dieses aber so verändern, dass die Farbwerte der Zelle B12 in die Zellen C12, D12 und E12 geschrieben werden. Da ich das für alle 56 Windows-Farben machen will, soll der Vorgang bis in Zelle B68 wiederholt werden (Ergebnisse in C68, D68 und E68 schreiben). Das ursprüngliche Makro mit Message-Box lautet so:

Sub GetCellColor()

    With ActiveCell
        idx = ActiveCell.Interior.ColorIndex
        deci = ActiveCell.Interior.Color
        hexi = Hex(deci)
        While Len(hexi) < 6
            hexi = "0" & hexi
        Wend
        
        hexR = Mid(hexi, 5, 2) 'Hex R
        hexG = Mid(hexi, 3, 2) 'Hex G
        hexB = Mid(hexi, 1, 2) 'Hex B
        
        decR = CLng("&H" & Mid(hexi, 5, 2)) 'Dec R
        decG = CLng("&H" & Mid(hexi, 3, 2)) 'Dec G
        decB = CLng("&H" & Mid(hexi, 1, 2)) 'Dec b
        
    End With
    
    msg = msg & "Dec:" & vbTab & deci & vbCrLf
    msg = msg & "Hex:" & vbTab & hexi & vbCrLf
    msg = msg & "Idx:" & vbTab & idx & vbCrLf
    msg = msg & vbCrLf
    msg = msg & vbTab & "R" & vbTab & "G" & vbTab & "B" & vbCrLf
    msg = msg & "Hex:" & vbTab & hexR & vbTab & hexG & vbTab & hexB & vbCrLf
    msg = msg & "Dec:" & vbTab & decR & vbTab & decG & vbTab & decB & vbCrLf
    
    MsgBox msg, vbOKOnly, "Activecell Color Info"
    
End Sub



Es wäre nett, wenn mir jemand helfen könnte.
Beste Grüsse von Hartmut
  


Betrifft: AW: Zellmotiffarbe als RGB-Wert auslesen von: nighty
Geschrieben am: 21.08.2004 20:12:21

hi hartmut :)

wie gewuenscht :)

gruss nighty

Sub GetCellColor()
Dim zeilen As Long
Dim deci As Long
Dim hexi As Variant
For zeilen = 12 To 68
With ActiveCell
deci = Cells(zeilen, 2).Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
Cells(zeilen, 3) = CLng("&H" & Mid(hexi, 5, 2))
Cells(zeilen, 4) = CLng("&H" & Mid(hexi, 3, 2))
Cells(zeilen, 5) = CLng("&H" & Mid(hexi, 1, 2))
End With
Next zeilen
End Sub



  


Betrifft: AW: Zellmotiffarbe als RGB-Wert auslesen von: HartmutM
Geschrieben am: 21.08.2004 20:37:31

High nighty,
Danke für Deine schnelle Hilfe. Funzt genau wie gewünscht.
Beste Grüsse von Hartmut


  


Betrifft: AW: Zellmotiffarbe als RGB-Wert auslesen von: H.W Schmidt
Geschrieben am: 21.08.2004 20:54:20

Hallo Hartmut
siehe dir trozdem mal folgendes an
https://www.herber.de/bbs/user/9925.xls

Tschüs H.W


  


Betrifft: AW: Zellmotiffarbe als RGB-Wert auslesen von: HartmutM
Geschrieben am: 22.08.2004 00:48:33

Hallo nighty,
Leider muss ich Dich noch einmal belästigen - Dein Makro läuft zwar und schriebt die Werte dorthin wo ich will, doch ist das Ergebnis falsch bzw nicht gewünscht.
Zur Erinnerung: Ich will den AKTUELLEN RGB-Wert der Zellfarbe auslesen.
Hier die Beispiele:
Das ursprüngliche Makro liest wirklich die aktuellen Farben aus:

Sub GetCellColor()
    With ActiveCell
        idx = ActiveCell.Interior.ColorIndex
        deci = ActiveCell.Interior.Color
        hexi = Hex(deci)
        While Len(hexi) < 6
            hexi = "0" & hexi
        Wend      
        hexR = Mid(hexi, 5, 2) 'Hex R
        hexG = Mid(hexi, 3, 2) 'Hex G
        hexB = Mid(hexi, 1, 2) 'Hex B        
        decR = CLng("&H" & Mid(hexi, 5, 2)) 'Dec R
        decG = CLng("&H" & Mid(hexi, 3, 2)) 'Dec G
        decB = CLng("&H" & Mid(hexi, 1, 2)) 'Dec b        
    End With    
    msg = msg & "Dec:" & vbTab & deci & vbCrLf
    msg = msg & "Hex:" & vbTab & hexi & vbCrLf
    msg = msg & "Idx:" & vbTab & idx & vbCrLf
    msg = msg & vbCrLf
    msg = msg & vbTab & "R" & vbTab & "G" & vbTab & "B" & vbCrLf
    msg = msg & "Hex:" & vbTab & hexR & vbTab & hexG & vbTab & hexB & vbCrLf
    msg = msg & "Dec:" & vbTab & decR & vbTab & decG & vbTab & decB & vbCrLf    
    MsgBox msg, vbOKOnly, "Activecell Color Info"
End Sub


Doch Dein Makro errechnet die RGB-Werte die dem Windows-Farbindex (bei Reset.Color)entsprechen:
Sub GetCellColor2()
' von nighty (Excel-Forum, 21.08.2004)
Dim zeilen As Long
Dim deci As Long
Dim hexi As Variant
For zeilen = 11 To 66
With ActiveCell
deci = Cells(zeilen, 2).Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
Cells(zeilen, 3) = CLng("&H" & Mid(hexi, 5, 2))
Cells(zeilen, 4) = CLng("&H" & Mid(hexi, 3, 2))
Cells(zeilen, 5) = CLng("&H" & Mid(hexi, 1, 2))
End With
Next zeilen
End Sub


Ich kann beim besten Willen (aber schlechten VBA-Kenntnissen) nicht sehen, wo der Fehler ist....
Danke für Deine Hilfe
Gute Nacht
Hartmut


 

Beiträge aus den Excel-Beispielen zum Thema "Zellmotiffarbe als RGB-Wert auslesen"