Office: VB zu VBA: Farbverlauf als Hintergrund im Formular

horse79 · 29. September 2002

Hallo,

wie kann ich denn als Hintergrund eines Formulares einen Farbverlauf realisieren? Entweder von oben nach unten oder von links nach rechts? Ich hab irgendwo in VB schonmal sowas gesehen, folglich sollte es ja auch über VBA realisierbar sein. Und welche Farben würdet Ihr zwecks guter Lesbarkeit und Ergonomie empfehlen?

Vielen Dank

:)

Phillip-Berlin · 1. Oktober 2002

ich habe das bisher mit einem verknüpften oder eingebetteten bild gemacht ..
soweit mir bekannt gibt es dafür keine funktion die access mitbringen würde ??

insgesamt würde ich mit einfarbigen hintergründen arbeiten ... die "bildvariante" finde ich eher nicht so gut

User · 1. Oktober 2002

Hallo Sven,

in mienem Archiv ausgegraben:

Erstelle ein Projekt mit einer Form und einem Command-Button (Command1).
Füge anschließend nachfolgenden Code ein:

Code:

DefLng A-Z

Sub Farbverlauf(obj As Object, Optional _
vRed As Variant, Optional vGreen As Variant, _
Optional vBlue As Variant, Optional vVert As Variant, _
Optional vHoriz As Variant, Optional vLightToDark _
As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next
With obj
Dim fAutoRedraw As Boolean, _
ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single
fAutoRedraw = .AutoRedraw: iDrawWidth = _
.DrawWidth
ordDrawStyle = .DrawStyle: ordDrawMode = _
.DrawMode
rScaleWidth = .ScaleWidth: rScaleHeight = _
.ScaleHeight
ordScaleMode = .ScaleMode
If Err Then Exit Sub
On Error GoTo 0
fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = vbInsideSolid: .DrawMode = vbCopyPen
.ScaleMode = vbPixels
.ScaleWidth = 256 * 2: .ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, _
y As Integer
Dim iRed As Integer, iGreen As Integer, _
iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If
clr = RGB(iRed, iGreen, iBlue)
If vVert Then
obj.Line (0, y)-(.ScaleWidth, _
y + 2), clr, BF
y = y + 2
End If
If vHoriz Then
obj.Line (x, 0)-(x + 2, _
.ScaleHeight), clr, BF
x = x + 2
End If
Next
.AutoRedraw = fAutoRedraw: .DrawWidth = _
iDrawWidth
.DrawStyle = ordDrawStyle: .DrawMode = _
ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth: .ScaleHeight = _
rScaleHeight
End With
End Sub

Private Sub Command1_Click()
Static Farben
Farben = Farben + 1
Select Case Farben
Case 1
'Gruen nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Grün nach Schwarz"
Farbverlauf Me, False, True, False, True, True, False
Case 2
'Gelb nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Gelb nach Schwarz"
Farbverlauf Me, True, True, False, True, False, True
Case 3
'Blau nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Blau nach Schwarz"
Farbverlauf Me, False, False, False, True, True, False
Case 4
'Hellblau nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Hellblau nach Schwarz"
Farbverlauf Me, False, True, True, True, False, True
Farben = 0
End Select

'Sytnax : Farbverlauf (ROT, GRUEN, BLAU, Horizontal, 'Vertikal, Winkel)
'Default Werte :
'- Rot = False
'- Gruen = False
'- Blau = True
'- Horizontal = True
'- Vertikal = False
'- Winkel = False

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Viel Spass beim Umsetzen in VBA.

Gruß

Arno

horse79 · 1. Oktober 2002

Vielen Dank,

ich werde es testen...

horse79 · 1. Oktober 2002

Hallo,

ich habe ein Modul erstellt:

Code:

Sub Farbverlauf(obj As Object, Optional vRed As Variant,
Optional vGreen As Variant, Optional vBlue As Variant,
Optional vVert As Variant, Optional vHoriz As Variant, Optional vLightToDark As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next

With obj
Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single

fAutoRedraw = .AutoRedraw
iDrawWidth = .DrawWidth
ordDrawStyle = .DrawStyle
ordDrawMode = .DrawMode
rScaleWidth = .ScaleWidth
rScaleHeight = .ScaleHeight
ordScaleMode = .ScaleMode

If Err Then Exit Sub
On Error GoTo 0

fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = vbInsideSolid
.DrawMode = vbCopyPen
.ScaleMode = vbPixels
.ScaleWidth = 256 * 2
.ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, y As Integer
Dim iRed As Integer, iGreen As Integer, iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If

clr = RGB(iRed, iGreen, iBlue)

If vVert Then
obj.Line (0, y)-(.ScaleWidth, y + 2), clr, BF
y = y + 2
End If

If vHoriz Then
obj.Line (x, 0)-(x + 2, .ScaleHeight), clr, BF
x = x + 2
End If

Next

.AutoRedraw = fAutoRedraw
.DrawWidth = iDrawWidth
.DrawStyle = ordDrawStyle
.DrawMode = ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth
.ScaleHeight = caleHeight
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich bekomme jetzt die Fehlermeldung bei:

Code:

.DrawStyle = vbInsideSolid
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fehlermeldung: Variable nicht definiert.

Ich denke dies ist eine Funktion die in VB vorhanden ist, aber nicht in VBA. Hat jemand diese Funktion für VBA bzw. weiß was diese bedeutet?

Vielen Dank *top

Manuela Kulpa · 2. Oktober 2002

Jepp, Sven, du hast recht *Smilie ! Nimm mal anstatt .DrawStyle = vbInsideSolid lieber .DrawStyle = 6!

slg

horse79 · 3. Oktober 2002

Hallo Manuela,

erstmal vielen Dank.

Code:

.DrawMode = vbCopyPen
.ScaleMode = vbPixels
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hättest Du mir hierfür auch noch die entsprechenden Zahlen?

Vielen Dank *top

Karlheinz · 3. Oktober 2002

Hallo Sven,

DrawMode=13
ScaleMode=3

müssten in Acc die entsprechenden Zahlen sein.

Gruß Karlheinz

horse79 · 3. Oktober 2002

Hi,

vielen Dank. Das Modul bringt keinen Kompilierfehler mehr *top

Wenn ich aber in meinem Form den Code ausführe ändert sich nur die Caption der Befehlsschaltfläche, aber nicht die Hintergrundfarbe des Forms. Es erscheint aber auch keine Fehlermeldung...

Code:

Private Sub Befehl0_Click()

Static Farben
Farben = Farben + 1

Select Case Farben

Case 1
'Gruen nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Grün nach Schwarz"
Farbverlauf Me, False, True, False, True, True, False

Case 2
'Gelb nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Gelb nach Schwarz"
Farbverlauf Me, True, True, False, True, False, True

Case 3
'Blau nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Blau nach Schwarz"
Farbverlauf Me, False, False, False, True, True, False

Case 4
'Hellblau nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Hellblau nach Schwarz"
Farbverlauf Me, False, True, True, True, False, True
Farben = 0

End Select

'Sytnax : Farbverlauf (ROT, GRUEN, BLAU, Horizontal,
'Vertikal, Winkel)
'Default Werte :
'- Rot = False
'- Gruen = False
'- Blau = True
'- Horizontal = True
'- Vertikal = False
'- Winkel = False

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und hier noch das Modul:

Code:

Sub Farbverlauf(obj As Object, Optional vRed As Variant,
Optional vGreen As Variant, Optional vBlue As Variant,
Optional vVert As Variant, Optional vHoriz As Variant, Optional vLightToDark As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next

With obj
Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single

fAutoRedraw = .AutoRedraw
iDrawWidth = .DrawWidth
ordDrawStyle = .DrawStyle
ordDrawMode = .DrawMode
rScaleWidth = .ScaleWidth
rScaleHeight = .ScaleHeight
ordScaleMode = .ScaleMode

If Err Then Exit Sub
On Error GoTo 0

fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = 6
.DrawMode = 13
.ScaleMode = 3
.ScaleWidth = 256 * 2
.ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, y As Integer
Dim iRed As Integer, iGreen As Integer, iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If

clr = RGB(iRed, iGreen, iBlue)

If vVert Then
obj.Line (0, y)-(.ScaleWidth, y + 2), clr, BF
y = y + 2
End If

If vHoriz Then
obj.Line (x, 0)-(x + 2, .ScaleHeight), clr, BF
x = x + 2
End If

Next

.AutoRedraw = fAutoRedraw
.DrawWidth = iDrawWidth
.DrawStyle = ordDrawStyle
.DrawMode = ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth
.ScaleHeight = rScaleHeight
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

horse79 · 3. Oktober 2002

Es ist doch noch ein Fehler im Modul, ich habe die On Error-Zeile übersehen... *holy

Der Fehler tritt hier auf:

Code:

fAutoRedraw = .AutoRedraw
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Anwendungs- oder objektdefinierter Fehler...

horse79 · 10. Oktober 2002

hopp

{//Modianmerkung// Hi Sven, habe 'mal ein paar "hepps" und "hopps" rausgenommen, damit die Zahl der Antworten nicht vom reinschauen abhält *wink.gif* Gruß Arno//}

[ 11. Oktober 2002: Beitrag editiert von: A.S. ]

Nouba · 15. Oktober 2002

Hallo Sven,

das ist zwar nicht ganz das Gesuchte, vielleicht nutzen die Routinen aber etwas. Drawing images on an Access form

Office: VB zu VBA: Farbverlauf als Hintergrund im Formular

VB zu VBA: Farbverlauf als Hintergrund im Formular

VB zu VBA: Farbverlauf als Hintergrund im Formular

VB zu VBA: Farbverlauf als Hintergrund im Formular

VB zu VBA: Farbverlauf als Hintergrund im Formular

VB zu VBA: Farbverlauf als Hintergrund im Formular - Similar Threads - VBA Farbverlauf Hintergrund

CSV-Daten per Makro einbinden - manuelle Wahl der Quelldatei

VBA löscht Spalte anstatt Zeile

VBA Summewenns mit Subtraktion

VBA - Zeilen je nach Bedingung in neues Tabellenblatt verschieben und löschen

VBA: Mit MsgBox bestimmte Inhalte von Zeile leeren

VBA Code Daten aus anderer Tabelle holen klappt nicht

Farbverlauf für Zellefarbe via VBA ausfühen