Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Themecolor...

Betrifft: Themecolor... von: Ivonne
Geschrieben am: 15.09.2014 17:25:10

Hi,

...mehrere in Userform zur Auswahl haben.

da meine Frage in diesem Tread

https://www.herber.de/forum/archiv/1380to1384/t1380538.htm#1381566


noch offen war, aber geschlossen wurde, solls hier weitergehen

gruss Ivonne.

  

Betrifft: AW: Themecolor... von: Hajo_Zi
Geschrieben am: 15.09.2014 17:52:09

Hallo Ivonne,

das siehst Du falsch, man kann dort noch Antworten.

GrußformelHomepage


  

Betrifft: Nur, wenn man weiß wie und auch nicht ewig! orT von: Luc:-?
Geschrieben am: 15.09.2014 17:54:21

Gruß, Luc :-?


  

Betrifft: Beachte aber auch, was ... von: Luc:-?
Geschrieben am: 15.09.2014 17:52:49

diesem BT folgend geschrieben wurde. Außerdem stellt sich mir die Frage, wofür du so etwas eigentlich benötigst, denn MS hat das offensichtlich nicht so (querbeet) vorgesehen, sondern Designer bemüht, die (sorgfältig) aufeinander und in sich (auch für spezielle Zwecke) abgestimmte FarbThemen geschaffen haben, die man wohl auch durch eigene ergänzen kann (Stichwort Corporate Identity).
Gruß, Luc :-?


  

Betrifft: AW: Beachte aber auch, was ... von: Ewald
Geschrieben am: 15.09.2014 23:36:47

Hallo,

auch hier mal eine kleine Hilfe

In Excel kann jeder Farbwert (RGB oder RGBlong) und jeder TASwert zwischen -1 bis 1 verwendet werden.

Um den Benutzer nun auch nicht noch mit der Farbgebung zu belasten, wurden fertige Design kreiert, die in einer DokumentTheme definiiert wurden.

Eine Dokumenttheme besteht aus 4 Dateien

die Dokumenttheme selbst
Colortheme
Fonttheme
Effekttheme

Sie sind zunächst eine Einheit, aber nicht starr, trotz eingestellter Dokumenttheme können andere Colorthemen,Fontthemen oder Effekthemen benutzt werden.

Thema hier ist die Colortheme

Diese besteht ja aus den 12 Grundfarben und den 5 festgelegren TAS-werten, die dann den harmonischen Ablauf der Farbgebung festlegen.

Hier hat MS aber wohl eher an dem alten Colorindex mit 56 Farben orientiert,als an eine größere Farbauswahl.

Für den normalen Benutzer dürfte diese Vorgabe der Colortheme ausreichend sein.

Doch gibt es auch Fälle wo man mehr Grundfarben oder mehr Farbabstufungen oder beides braucht.

Da aber auch benutzerdefinierte Colorthemen nicht mehr Farben bieten, bzw. der Farbauswahldialog nicht erweitert werden kann,bleibt nur der Ausweg sich selber einen Farbdialog zu erstellen.

Dieser müßte dann auch nicht auf vorhandene Colorthemen zugreifen, sondern könnte zB. alle RAL-Farben enthalten.

Auch können dann Infos zur Farbe direkt bei Auswahl angezeigt werden.

Wenn man jetzt vorhandene Colorthemen verwenden will, muß man wissen welche, denn bei 2010 (40) muß eine Auswahl getroffen werden.

Dies ist aber kein Problem.

Etwas anderes ist noch die Tatsache das die Colorthemendateien mit englischen Namen belegt sind.

Im Farbdialog sollten dann aber die deutschen Namen stehen, wie sie im Colorthemenauswahldialog erscheinen.

Bis jetzt konnte ich dazu aber keine gültige Liste finden.

Gruß Ewald


  

Betrifft: Deshalb hatte ich Ivonne ja auch RAL- ... von: Luc:-?
Geschrieben am: 16.09.2014 03:12:44

…bzw HTML-Farben für ihr AuswahlMenü vorgeschlagen, Ewald;
damit wäre dann der ganze ThemeColor-Zirkus verzichtbar, wenn dann auch direkt die RGB-Codes bzw Farbwerte übernommen/eingetragen wdn. Hexadezimale BGR-Werte mit &h-Vorsatz fktionieren in VBA übrigens genausogut.
Gruß, Luc :-?


  

Betrifft: Der Vollständigkeit halber ... von: Luc:-?
Geschrieben am: 16.09.2014 11:52:09

hier noch meine beiden letzten BTe im vorherigen Thread.
Luc :-?


  

Betrifft: AW: Der Vollständigkeit halber ... von: Ivonne
Geschrieben am: 16.09.2014 13:54:12

Hi,

ich brauche keine anderen Farben,

ich möchte nur mehrere Themen auf einmal zur Auswahl haben, damit ich nicht wenn ich eine Farbe aus einer anderen Theme haben will, über Seitenlayout die Theme wechseln muß.

Ewald hat ja gezeigt wie das aussieht, nur wie bekomme ich das hin.

gruss Ivonne


  

Betrifft: Indem du alle, die du zur Auswahl stellen ... von: Luc:-?
Geschrieben am: 16.09.2014 15:12:40

…willst, nacheinander lädst, ihre Farbwerte bzw -codes ausliest, notierst und dann alle Farben in Felder (solche mit Klick-Event und Tag-Eigenschaft, in der du den Farbwert notieren kannst) einer vorbereiteten UF übernimmst, Ivonne;
bei Klick kann so der Farbwert in die entsprd Eigenschaft der jeweiligen aktuellen Auswahl auf dem aktuellen Blatt per PgmCode eingetragen wdn.
Egal was du machst, du brauchst auf jeden Fall zumindest die Grund-(und evtl Zusatz-)Farben des Themes. Alles Andere kannst du Hinundher-Rechnen wie du willst, denn die TintAndShade-Werte dürften immer die gleichen sein und müssten folglich nur 1× (an einem Theme) ermittelt wdn. Wie das gerechnet wdn kann, hatte ich dir unter dem obigen Link gezeigt.
Gruß, Luc :-?


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ewald
Geschrieben am: 16.09.2014 23:39:55

Hallo Ivonne,

dann versuchen wir mal unser Glück,

Zuerst, wenn nicht schon geschehen, die Standardtheme "Larissa" laden und sie dann benutzerdefiniert als "Standard" speichern.

Diese Datei befindet sich jetzt im Ordner:

c:\Users\dein Name\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors\

von dort kopierst du die Datei in den Ordner:

c:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\

da wir jetzt einmal in dem Ordner sind sortierst du die Dateien nach Name aufsteigend (A nach Z, falls es nicht schon so ist). Jetzt suchst du deine 12 gewünschten Themen aus, indem du den Platz in der Ordnerliste auf einem Zettel notierst. (die erste Datei wäre die 1, die fünfte dann die 5, usw)

Damit sind die Vorbereitungen abgeschlossen.

Nun eine neue Exceldatei erstellen und in den VB-Editor gehen.

Dort eine Userform einfügen und ihr den Namen "frmFarben" geben.

in der oberen linken Ecke ein Image(Anzeige) einfügen, etwa in der Größe des Schließkreuzes in der Userform (ganz oben rechts der Userform).Dem Image dann als BackColor die Farbe rot zuweisen.

nun in den Codebereich der Userform gehen (rechte Maustaste Code anzeigen)

Dort fügst du folgende Codes ein.

Private Sub Image1_Click()
frmFarben.Hide
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim c As Range
For Each c In Selection
c.Interior.Color = xlNone
Next
frmFarben.Hide
End Sub

Private Sub UserForm_Initialize()
Call Farbensetzen
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        MsgBox "Bitte benutzen sie oben links das rote Image zum Verlassen des Formulars.",  _
vbInformation, "Abbruch"
        Cancel = True
    End If
End Sub
Damit ist die Userform fertig.

Füge nun ein Modul ein,dort dann folgende Codes reinkopieren
Public cLabel() As New clsLabel
Public cButton() As New clsButton
Public mycontrol As String
Public myadr As String
Public Bereich As Range
Public Dateiname As String
Public Dateipfad As String
Public Start As Long


Sub Farbensetzen()
    Dim myleft As Integer
    Dim tbcount As Integer
    Dim i As Long
    Dim k
    Dim l
    Dim m
    Dim s As Long
    Dim t As Long
    Dim u As String
    Dim w As Long
    Dim x As Long
    Dim Y As Long
    Dim z As Long
    Dim Farbe
    Dim newtb As Control
    Dim myarr
    On Error Resume Next

myleft = 5
ReDim myarr(1)
myarr = Array(36, 2, 20, 6, 26, 30, 31, 32, 34, 37, 40, 42)
s = 1
t = 1
Farbe = &H80000005
With frmFarben
For m = 1 To 3
x = 10
Y = 50
For l = 1 To 4
     Set newtb = .Controls.Add("Forms.Textbox.1")
             With newtb
                .Name = "TB" & t
                .Left = myleft
                .Top = Y
                .Width = 55
                .Height = 15
                .BackColor = &H80000005
                .ForeColor = &HFF&
                .SelectionMargin = False
                .Enabled = True
                .Font.Bold = True
                .Text = lesen(CDbl(myarr(t - 1)))
                If .Text = "Standard" Then .Text = "Larissa"
            End With
            t = t + 1
            Y = Y + 100
            w = myleft + 60
            Start = s
  For k = 1 To 6
     For i = 1 To 12
    
        Set newtb = .Controls.Add("Forms.Label.1")
             With newtb
                .Name = "Label" & s
                .Left = w
                .Top = x
                .Width = 10
                .Height = 10
                .TextAlign = 2
                .BackColor = &H80000002
                
                .BorderStyle = 1
                .Font.Size = 10
            End With
            w = w + 15
            s = s + 1
    Next
    x = x + 15
    w = myleft + 60
   
Next
Call Farben
x = x + 10
Next
myleft = myleft + 240
Next
 Set newtb = .Controls.Add("Forms.CommandButton.1")
             With newtb
                .Name = "CB1"
                 .Caption = "Weitere Farben"
                .Left = 350
                .Top = x
                .Width = 100
                .Height = 20
                .TextAlign = 2
                .BackColor = &HC0FFFF
                .BorderStyle = 1
                .Font.Size = 10
            End With
            x = x + 30
For Each newtb In frmFarben.Controls
    If TypeName(newtb) = "Label" Then
        tbcount = tbcount + 1
        If tbcount > 1 And tbcount < 900 Then
            ReDim Preserve cLabel(1 To tbcount)
            Set cLabel(tbcount).Label = newtb
        End If
    End If
Next newtb
For Each newtb In frmFarben.Controls
    If TypeName(newtb) = "CommandButton" Then
        tbcount = tbcount + 1
        If tbcount > 1 And tbcount < 900 Then
            ReDim Preserve cButton(1 To tbcount)
            Set cButton(tbcount).Button = newtb
        End If
    End If
Next newtb
End With
frmFarben.Top = 0
frmFarben.Left = 0
frmFarben.Width = 730
frmFarben.Height = x + 15
frmFarben.Show
End Sub
Function lesen(Index As Long) As String
Dim Ordner As String
Dim Liste As String
Dim myarr(42) As Variant
Dim i As Long
Dim fo As Object
Dim fi As Object
Dim fso As Object
Ordner = "c:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\"
Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.GetFolder(Ordner)
 i = 0
For Each fi In fo.Files
          myarr(i) = Left(fi.Name, Len(fi.Name) - 4)
          i = i + 1
Next
lesen = myarr(Index - 1)
Dateiname = lesen & ".xml"

Dateipfad = Ordner & Dateiname
End Function
Sub Farben()
Dim i
Dim k
Dim x
   Dim arr
   ReDim arr(1 To 5)
   
   arr(1) = Array(-0.049989319, 0.499984741, -0.99948119, 0.799981689, 0.799981689, 0.799981689, _
 0.799981689, 0.799981689, 0.799981689, 0.799981689, 0.799981689, 0.799981689)
   arr(2) = Array(-0.149967956, 0.349986267, -0.249946593, 0.599963378, 0.599963378, 0. _
599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378)
   arr(3) = Array(-0.249946593, 0.249946593, -0.499984741, 0.399945067, 0.399945067, 0. _
399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067)
   arr(4) = Array(-0.349986267, 0.149967956, -0.749961852, -0.249946593, -0.249946593, -0. _
249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593)
   arr(5) = Array(-0.499984741, 0.049989319, -0.899960326, -0.499984741, -0.499984741, -0. _
499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741)
ActiveWorkbook.Theme.ThemeColorScheme.Load (Dateipfad)
With frmFarben
    .Controls("Label" & Start).BackColor = ThisWorkbook.Theme.ThemeColorScheme.Colors(2)
    .Controls("Label" & (Start)).ControlTipText = .Controls("Label" & (Start)).BackColor
    .Controls("Label" & (Start + 1)).BackColor = ThisWorkbook.Theme.ThemeColorScheme.Colors(1)
    .Controls("Label" & (Start + 1)).ControlTipText = .Controls("Label" & (Start + 1)). _
BackColor
    .Controls("Label" & (Start + 2)).BackColor = ThisWorkbook.Theme.ThemeColorScheme.Colors(4)
    .Controls("Label" & (Start + 2)).ControlTipText = .Controls("Label" & (Start + 2)). _
BackColor
    .Controls("Label" & (Start + 3)).BackColor = ThisWorkbook.Theme.ThemeColorScheme.Colors(3)
    .Controls("Label" & (Start + 3)).ControlTipText = .Controls("Label" & (Start + 3)). _
BackColor
For i = 4 To 11
    .Controls("Label" & (Start + i)).BackColor = ThisWorkbook.Theme.ThemeColorScheme.Colors(i +  _
1)
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next

For i = 12 To 23
    .Controls("Label" & (Start + i)).BackColor = Col(.Controls("Label" & (Start + i - 12)). _
BackColor, CDbl(arr(1)(i - 12)))
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next
For i = 24 To 35
    .Controls("Label" & (Start + i)).BackColor = Col(.Controls("Label" & (Start + i - 24)). _
BackColor, CDbl(arr(2)(i - 24)))
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next
For i = 36 To 47
    .Controls("Label" & (Start + i)).BackColor = Col(.Controls("Label" & (Start + i - 36)). _
BackColor, CDbl(arr(3)(i - 36)))
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next
For i = 48 To 59
    .Controls("Label" & (Start + i)).BackColor = Col(.Controls("Label" & (Start + i - 48)). _
BackColor, CDbl(arr(4)(i - 48)))
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next
For i = 60 To 71
    .Controls("Label" & (Start + i)).BackColor = Col(.Controls("Label" & (Start + i - 60)). _
BackColor, CDbl(arr(5)(i - 60)))
    .Controls("Label" & (Start + i)).ControlTipText = .Controls("Label" & (Start + i)). _
BackColor
Next

End With
End Sub
Function Col(Color As Long, Tas As Double) As Long
Dim r
Dim R1
Dim g
Dim G1
Dim b
Dim B1
 r = Color Mod 256
    g = (Color \ 256) Mod 256
    b = (Color \ 256 \ 256) Mod 256
 If Tas > 0 Then
    R1 = r + WorksheetFunction.RoundUp(Tas * (255 - r), 0)
    G1 = g + WorksheetFunction.RoundUp(Tas * (255 - g), 0)
    B1 = b + WorksheetFunction.RoundUp(Tas * (255 - b), 0)
Else
    R1 = r + WorksheetFunction.RoundDown(Tas * r, 0)
    G1 = g + WorksheetFunction.RoundDown(Tas * g, 0)
    B1 = b + WorksheetFunction.RoundDown(Tas * b, 0)
End If
If R1 < 0 Then r = 0
If G1 < 0 Then g = 0
If B1 < 0 Then b = 0
Col = RGB(R1, G1, B1)
End Function
Sub farbdialog()
frmFarben.Show
End Sub
nun noch zwei Klassenmodule einfügen

das erste umbenennen in "clsButton" und dort folgenden Code einfügen
Public WithEvents Button As MSForms.CommandButton
Private Sub Button_Click()
Application.Dialogs(xlDialogPatterns).Show
End Sub
das zweite umbenennen in "clsLabel" und dort folgenden Code einfügen.
Public WithEvents Label As MSForms.Label
Private Sub Label_Click()
Dim c As Range
For Each c In Selection
c.Interior.Color = Label.BackColor
Next
frmFarben.Hide
End Sub
Das wäre dann schon alles im VB-Editor und er kann geschlossen werden.

Damit wir bequem die Userform öffnen können,setzen wir in der Schnellstartleiste ein Symbol.

Rechtsklick auf die Leiste Leiste anpassen, nun unter Befehle auswählen,Makros einstellen.

Nun solltest du in der Liste "farbdialog" finden,diesen markieren und mit dem Button "Hinzufügen" auf die rechte Seite einfügen. Wenn du jetzt auf "Ändern" klickst, kannst du noch ein Symbol vergeben.

Nun kannst du die Userform über das Symbol aufrufen.(Beim erstenmal dauert es etwas.

Nun sollten dir 12 komplette Themen angezeigt werden.

Fährst du mit der Maus über die Label wird dir die Farbnummer schon mal angezeigt.

klickst du auf ein Label werden die vorher markierten Zellen mit der Farbe versehen und die Userform wird geschlossen.

Willst du Zellen wieder entfärben, einfach ein Doppelklick auf die Userform (nicht auf ein Label)

mit dem Button "Erweiterte Farben" wird dann noch ein Dialog geöffnet,wo du weitere Farben wählen kannst.

Durch Klick auf das Image oben links wird die Userform geschlossen.

Das wars dann.

Nein nicht ganz, da war doch noch der Zettel mit deiner Auswahl.

Im Modul1 im Code Farbensetzen gibt es diese Zeile
myarr = Array(36, 2, 20, 6, 26, 30, 31, 32, 34, 37, 40, 42)
damit deine Auswahl erscheint gebe in der Klammer deine notierten Zahlen ein.

Gruß Ewald


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ewald
Geschrieben am: 17.09.2014 00:42:01

Hallo Ivonne,

noch ein Nachtrag.

sollte in den Textboxen trotz Font.Bold = True die Schrift nicht Fett sein, dann sag Bescheid.

Gruß Ewald


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ivonne
Geschrieben am: 17.09.2014 14:10:32

Hi Ewald,

habe es fast hinbekommen, nur mit den Klassenmodulen haperst.

Wenn ich die einfüge, steht da Klasse1 bzw. Klasse2, wie kann ich die jetzt umbenennen.

gruss Ivonne


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ewald
Geschrieben am: 17.09.2014 21:38:48

Hallo Ivonne,

einfach das Klassenmodul markieren und das Eigenschaftenfenster aufrufen, dort kannst du den Namen oben ändern.

Mir ist beim Durchsehen aufgefallen, das da noch was fehlt.

Füge im Modul1 noch folgenden Code ein

Function SelectColor(Optional lngInitialColor As Long = 16777215) As Long
Dim lngResult As Long, lngO As Long, intR As Integer, intG As Integer, intB As Integer
lngResult = xlNone
If Not ActiveWorkbook Is Nothing Then
    lngO = ActiveWorkbook.Colors(1)
    intR = lngInitialColor And 255
    intG = lngInitialColor \ 256 And 255
    intB = lngInitialColor \ 256 ^ 2 And 255
    If Application.Dialogs(xlDialogEditColor).Show(1, intR, intG, intB) = True Then
        lngResult = ActiveWorkbook.Colors(1)
        ActiveWorkbook.Colors(1) = lngO
    End If
End If
SelectColor = lngResult
End Function
und ersetze den Code im Klassenmodul clsButton durch diesen
Public WithEvents Button As MSForms.CommandButton
Private Sub Button_Click()
Dim c As Range
Dim a
a = SelectColor(ActiveCell.Interior.Color)
For Each c In Selection
    c.Interior.Color = a
Next
frmFarben.Hide
End Sub
jetzt wird direkt das erweiterte Farbfenster aufgerufen.

Gruß Ewald


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ivonne
Geschrieben am: 18.09.2014 11:29:04

Hi,

habe es hinbekommen und es funktioniert hervorragend.

Nu zwei Dinge wären noch schön.

Die Namen der ausgewählten Theme in Deutsch wären.
Die Schrift in den TextBoxen fett wären, ist wie du erwähnt hast nicht der Fall.

Es ist schon toll was man mit VBA alles machen kann.

gruss Ivonne


  

Betrifft: AW: Indem du alle, die du zur Auswahl stellen ... von: Ewald
Geschrieben am: 18.09.2014 23:04:20

Hallo Ivonne,

da ich keine Liste finden konnte,Dateiname/Auswahlname der Themen habe ich mal eine erstellt

 AB
1DateinameAuswahlname
2AdjacencyNähe
3Alte FarbenAlte Farben
4AnglesWinkel
5ApexAnanke
6ApothecaryApotheke
7AspectGanymed
8AustinAustin
9Black TieSmoking
10CivicCronus
11ClarityKlarheit
12CompositeZusammengesetzt
13ConcourseDeimos
14CoutureCouture
15ElementalElementar
16EquityDactylos
17EssentialEssenz
18ExecutiveExecutive
19FlowHyperion
20FoundryPhoebe
21GrayscaleGraustufe
22GridRaster
23HardcoverHardcover
24HorizonHorizont
25MedianGalathea
26MetroIapetus
27ModuleModul
28NewsprintZeitungspapier
29OpulentLysithea
30OrielNereus
31OriginOkeanos
32PaperPapier
33PerspectivePerspective
34PushpinPin
35SlipstreamSlipstream
36SolsticeNyad
37StandardLarissa
38TechnicHaemera
39ThatchStroh
40TrekMetis
41UrbanRhea
42VerveTelesto
43WaveformWellenform
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg
Außer "Alte Farben" und "Standard" sind das die 40 Colorthemen in Excel 2010.

wie ich die jetzt noch in den Code bekomme, muß ich mir noch ansehen.

Um die Schrift in den Textboxen Fett darzustellen, muß man in die Registry.


Hier jetzt sorgfältig und genau vorgehen, (lieber 3mal kontrollieren, als einmal falsch)!!!


Auf Ausführen klicken und dann regedit eingeben.

Dann auf der linken Seite sich genau zu diesem Eintrag durcharbeiten.

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX
Compatibility\{3B7C8860-D78F-101B-B9B5-04021C009402}

Der Schlüssel muß 100% so heißen, falls nicht vorhanden abbrechen.

wenn du diesen Eintrag jetzt markierst, sollten auf der rechten Seite 2 Einträge sein

im untersten Eintrag sollte jetzt am Ende der Zahl vor (1024) eine 400 stehen.

diese 400 ist ein Killbit und verhindert die Fettschreibung.

Jetzt den zweiten Eintrag markieren,rechte Maustaste (Ändern)

Im aufgegangenen Fenster siehst du die 400, diese jetzt durch 0 ersetzen

Mit OK abschließen und den Editor schließen.

Nach einem Neustart von Excel sollten dann die Textboxen fett dargestellt werden.

Gruß Ewald


  

Betrifft: OT: Hatte dir im anderen Thread ... von: Luc:-?
Geschrieben am: 19.09.2014 15:22:18

…(jetzt nur noch Archiv) nochmal geantwortet, Ewald.
Mit dem hier gezeigten müsste man auch mal überprüfen, ob die so erzeugten Farben als ThemeColors erkannt wdn. Immerhin hast du ja wohl Original-T&S-Werte verwendet.
Gruß, Luc :-?


  

Betrifft: AW: OT: Hatte dir im anderen Thread ... von: Ewald
Geschrieben am: 20.09.2014 19:33:50

Hallo Luc,

bei Bedarf können wir ja einen neuen Tread bezugnehmend auf den alten eröffnen.

ich nehme mal an du meinst die Farben aus der Userform.

Natürlich kann man dies überprüfen, dazu müssen die Farben aller Themen in eine Tabelle eingelesen werden.(Makro vorhanden)

Dann kann mit einem anderen Makro(ebenfalls vorhanden) die Farbe in der Tabelle gesucht werden und gibt dann die Theme und den Namen der Farbe wieder.

Dies gilt aber nur für die Farben, die auf den Labels sind.

Da es aber auch möglich ist die erweiterte Farbauswahl aufzurufen und dort eine Farbe zu wählen, wirst du diese eventuell nicht finden. Aber das ist ja auch im normalen Farbdialog so.

Für den normalen Excelbenutzer ist es eh egal ob die Farbe jetzt Akzent1 oder Akzent6 heißt.

Gruß Ewald


  

Betrifft: Ja, da hast du natürlich recht, ... von: Luc:-?
Geschrieben am: 20.09.2014 21:04:22

…Ewald,
aber da ich von der „anderen Seite her“ komme, also per UDF feststellen will, ob eine ZellFarbe eine Farbe des aktuellen Themes ist, kommt es darauf schon eher an. Allerdings frustiert mich in diesem Zusammenhang das MS-eigene „Bäumchen-(ver)wechsel-dich“-Spiel bei den ersten 4 Indizes schon: .Interior.ThemeColor=1/2/3/4 ⇔ .ThemeColorScheme.Colors.Items=2/1/4/3
Ist das unter Xl14/2010 auch so?
Z.Z. habe ich erst mal keinen über das Bisherige hinausgehenden Diskussionsbedarf. Muss da erst mal noch ein Stück weiter kommen.
Dank & Gruß, Luc :-?


  

Betrifft: AW: Ist mir schon klar.... von: Ewald
Geschrieben am: 20.09.2014 23:44:30

Hallo Luc,

... das du mit UDF abfragen willst, nur wie gesagt kein Problem, die Grundfarben kannst du ja mit Colors(x)abfragen und die TAS-Werte liegen ja in meinem Code als Array vor,außerdem ist dort auch die Function col die dann Color wiedergibt.

Momentan versuche ich aus einer Themenfarbe die Grundfarbe zu ermitteln, nur scheint da auch VBA Grenzen zu haben. (Mit Excelformeln brauchts du erst garnicht probieren)

Für positve Tas-Werte aus der Grundformel

Farbwert = Basiswert + TaS * (255 - Basiswert)
ergibt sich für die Rückrechnung eigentlich folgende Formel

Basiswert = (Farbwert- 255*TaS)/ (-TaS+1)
das paßt aber leider nicht immer.

Das Wechselspielchen ist zumindest zu erklären, in den alten Excelversionen war Schwarz immer die Startfarbe, dies hat man auch in den neuen Versionen beibehalten, (siehe neue Designfarben erstellen)um abwärts kompatibel zu sein.

Bei dem Farbauswahldialog sieht das aber anders aus, die sind ja nur für die jeweilige Version gültig, und da für einen Designer eine Farbpalette die mit Schwarz beginnt, eigentlich ein NoGo ist, hat man dort getauscht. Eigentlich auch kein Problem, nur wenn man hinter die Kulisse schauen will, muß man darauf achten.

Nun muß ich mich aber mal um die Colorthemennamen kümmern, wie ich die Dateinamen und die Auswahlnamen in ein Array bekomme, damit Ivonne dann auch die Auswahlnamen in der Userform hat.

Gruß Ewald


  

Betrifft: Ja, mach das, Ewald, Montag will Ivonne das ... von: Luc:-?
Geschrieben am: 21.09.2014 02:05:23

…sicher haben… ;-]
Ansonsten schnell noch, warum dann auch 3 und 4 vertauscht? Analoges kam auch früher schon an anderer Stelle vor — die Einen designen wohl bzw legen Konstanten fest, um die die Anderen sich dann nur kümmern, wenn sie Lust (und Zeit) dazu haben, deren Arbeiten zu studieren… ;-]
Wenn man aus der Grundfarbe über T&S zur skalierten Farbe kommt, müsste doch auch der umgekehrte Weg fktionieren, sofern T&S vorliegt, was ja lt der von mir bereits angeführten Beobachtungen (also je nach FärbeMethode ggf T&S=0) nicht mal für das aktuelle Theme gewährleistet ist. Aber einfach wird das sicher nicht, denn, wenn man sich die komplexen UmrechnungsFmln RGB→HSL→RGB ansieht, ist das ein ganzer Algorithmus mit FallEntscheidungen. Eine solche Fml würde wohl unverhältnismäßig lang ausfallen, weshalb dann sicher eine UDF, die das erledigt, besser wäre. Da ich aber noch nicht versucht habe, auf die jeweilige GrundFarbe rückzurechnen, kann ich dazu natürlich auch noch nichts Entscheidendes beisteuern. Meine bisherigen Fmln waren ja auch speziell auf die konkrete Situation abgestellt.
Ggw versuche ich, aus der RGB→HSL→HSL'→R'G'B'-Strecke einen Gesamt­Algorithmus RGB→R'G'B' zu kreieren. Evtl komme ich so auch der Problematik R'G'B'→RGB näher…
Will mal hoffen, dass mich das heute abend im Garten meines Wohnhauses (mind 1 Siedlungs-km vom nächsten Wald entfernt!) aufgetauchte Reh entsprechend inspiriert (unser Nachbar hatte im Frühjahr 2012∨13 sogar eine Bache im Pool, die Frischlinge liefen drumherum!).
Viel Erfolg! Luc :-?


  

Betrifft: AW: Ja, mach das, Ewald, Montag will Ivonne das ... von: Ewald
Geschrieben am: 21.09.2014 19:44:18

Hallo,

@Ivonne

damit in der Userform die Colorthemenauswahlnamen erscheinen, ersetze im Modul1 die Function lesen durch diese.

Function lesen(Index As Long) As String
Dim Ordner As String
Dim Liste As String
Dim myarr(42) As Variant
Dim myarr2 As Variant
Dim Text As String
Dim i As Long
Dim k As Long
Dim fo As Object
Dim fi As Object
Dim fso As Object
ReDim myarr2(2)
myarr2(0) = Array("Adjacency", "Alte Farben", "Angles", "Apex", "Apothecary", "Aspect", "Austin" _
, "Black Tie", "Civic", "Clarity", "Composite", "Concourse", "Couture", "Elemental", "Equity", "Essential", "Executive", "Flow", "Foundry", "Grayscale", "Grid", "Hardcover", "Horizon", "Median", "Metro", "Module", "Newsprint", "Opulent", "Oriel", "Origin", "Paper", "Perspective", "Pushpin", "Slipstream", "Solstice", "Standard", "Technic", "Thatch", "Trek", "Urban", "Verve", "Waveform")
myarr2(1) = Array("Nähe", "Alte Farben", "Winkel", "Ananke", "Apotheke", "Ganymed", "Austin", " _
Smoking", "Cronus", "Klarheit", "Zusammengesetzt", "Deimos", "Couture", "Elementar", "Dactylos", "Essenz", "Executive", "Hyperion", "Phoebe", "Graustufe", "Raster", "Hardcover", "Horizont", "Galathea", "Iapetus", "Modul", "Zeitungspapier", "Lysithea", "Nereus", "Okeanos", "Papier", "Perspective", "Pin", "Slipstream", "Nyad", "Larissa", "Haemera", "Stroh", "Metis", "Rhea", "Telesto", "Wellenform")
Ordner = "c:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\"
Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.GetFolder(Ordner)
 i = 0
For Each fi In fo.Files
          myarr(i) = Left(fi.Name, Len(fi.Name) - 4)
          i = i + 1
Next
lesen = myarr(Index - 1)
For k = LBound(myarr2(0)) To UBound(myarr2(0))
    If myarr2(0)(k) = lesen Then Text = myarr2(1)(k)
Next
Dateiname = lesen & ".xml"
Dateipfad = Ordner & Dateiname
lesen = Text
End Function
soll in der Tabelle die alle Colorthemenfarben anzeigt auch der Colorthemenauswahlname erscheinen, dann folgenden Code benutzen.
Public zeile As Long
Public datname As String
Public datpfad As String
Sub Themen()
Dim Ordner As String
Dim Anzahl As Long
Dim Anzahlxml
Dim Liste As String
Dim i
Dim fo As Object
Dim fi As Object
Dim fso As Object
Ordner = "c:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\"
zeile = 3
Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.GetFolder(Ordner)
    
For Each fi In fo.Files
        Anzahl = Anzahl + 1
        datname = (fi.Name)   'LCase
        If Right(datname, 4) = ".xml" Then
            Anzahlxml = Anzahlxml + 1
            Liste = Liste & Left(fi.Name, Len(fi.Name) - 4) & Chr(13)
            datpfad = Ordner & datname
            Call Schreiben
           zeile = zeile + 7
        End If
Next

ActiveWorkbook.Theme.ThemeColorScheme.Load ("C:\Program Files\Microsoft Office\Document Themes  _
14\Theme Colors\Standard.xml")
End Sub
Sub Schreiben()
Dim i
Dim k
Dim x
Dim z
Dim Text As String
Dim myarr2 As Variant
   Dim arr
   ReDim arr(1 To 5)
   
   arr(1) = Array(-0.049989319, 0.499984741, -0.99948119, 0.799981689, 0.799981689, 0.799981689, _
 0.799981689, 0.799981689, 0.799981689, 0.799981689, 0.799981689, 0.799981689)
   arr(2) = Array(-0.149967956, 0.349986267, -0.249946593, 0.599963378, 0.599963378, 0. _
599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378, 0.599963378)
   arr(3) = Array(-0.249946593, 0.249946593, -0.499984741, 0.399945067, 0.399945067, 0. _
399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067, 0.399945067)
   arr(4) = Array(-0.349986267, 0.149967956, -0.749961852, -0.249946593, -0.249946593, -0. _
249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593, -0.249946593)
   arr(5) = Array(-0.499984741, 0.049989319, -0.899960326, -0.499984741, -0.499984741, -0. _
499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741, -0.499984741)
ReDim myarr2(2)
myarr2(0) = Array("Adjacency", "Alte Farben", "Angles", "Apex", "Apothecary", "Aspect", "Austin" _
, "Black Tie", "Civic", "Clarity", "Composite", "Concourse", "Couture", "Elemental", "Equity", "Essential", "Executive", "Flow", "Foundry", "Grayscale", "Grid", "Hardcover", "Horizon", "Median", "Metro", "Module", "Newsprint", "Opulent", "Oriel", "Origin", "Paper", "Perspective", "Pushpin", "Slipstream", "Solstice", "Standard", "Technic", "Thatch", "Trek", "Urban", "Verve", "Waveform")
myarr2(1) = Array("Nähe", "Alte Farben", "Winkel", "Ananke", "Apotheke", "Ganymed", "Austin", " _
Smoking", "Cronus", "Klarheit", "Zusammengesetzt", "Deimos", "Couture", "Elementar", "Dactylos", "Essenz", "Executive", "Hyperion", "Phoebe", "Graustufe", "Raster", "Hardcover", "Horizont", "Galathea", "Iapetus", "Modul", "Zeitungspapier", "Lysithea", "Nereus", "Okeanos", "Papier", "Perspective", "Pin", "Slipstream", "Nyad", "Larissa", "Haemera", "Stroh", "Metis", "Rhea", "Telesto", "Wellenform")
ActiveWorkbook.Theme.ThemeColorScheme.Load (datpfad)
z = Left(datname, Len(datname) - 4)
For k = LBound(myarr2(0)) To UBound(myarr2(0))
    If myarr2(0)(k) = z Then Text = myarr2(1)(k)
Next
With Worksheets(1)
    .Cells(zeile, 1).Value = Left(datname, Len(datname) - 4)
    .Cells(zeile, 2).Value = Text
    .Cells(zeile, 3).Value = ThisWorkbook.Theme.ThemeColorScheme.Colors(2)
    .Cells(zeile, 3).Interior.Color = .Cells(zeile, 3).Value
    .Cells(zeile, 4).Value = ThisWorkbook.Theme.ThemeColorScheme.Colors(1)
    .Cells(zeile, 4).Interior.Color = .Cells(zeile, 4).Value
    .Cells(zeile, 5).Value = ThisWorkbook.Theme.ThemeColorScheme.Colors(4)
    .Cells(zeile, 5).Interior.Color = .Cells(zeile, 5).Value
    .Cells(zeile, 6).Value = ThisWorkbook.Theme.ThemeColorScheme.Colors(3)
    .Cells(zeile, 6).Interior.Color = .Cells(zeile, 6).Value
    
For i = 7 To 14

    .Cells(zeile, i).Interior.Color = ThisWorkbook.Theme.ThemeColorScheme.Colors(i - 2) 'Colors( _
x)
    .Cells(zeile, i).Value = .Cells(zeile, i).Interior.Color
Next i
k = zeile + 1
    Cells(k, 3).Resize(UBound(arr, 1), UBound(arr(1), 1) + 1) = _
      WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
   
For x = k To k + 4
    For i = 3 To 14
        .Cells(x, i).Interior.Color = .Cells(zeile, i).Value
        .Cells(x, i).Interior.TintAndShade = .Cells(x, i).Value
        .Cells(x, i).Value = Col(.Cells(zeile, i).Value, .Cells(x, i).Value)
    Next
Next
End With
End Sub
@Luc

die xlthemennamen heißen ja (deutsch) Dunkel1,Hell1,Dunkel2,Hell2, wenn jetzt im Farbdialog Dunkel1 und Hell1 getauscht werden, scheint es doch logisch das auch mit Dunkel2 und Hell2 zu machen.

Was die Funktion zur Umwandlung zurück angeht, ist diese schon korrekt, Problem sind nur das Auf- bzw. Abrunden. Hier habe ich die richtige Anwendung noch nicht gefunden.

Gruß Ewald