Suche | Statistiken | Benutzerliste | Access-FAQ | Datenschutz Foren
donkarl Forum
donkarl Forum ->  Themen -> Access -> Diskussion ansehen

Du bist als Gast eingelogt. ( Anmelden | Registrieren )
  • Formulargrösse
  • dreho16.03.17 07:27
       └ RE: Formulargrösse Karl Donaubauer16.03.17 15:14
  • Access Stammtisch München am 09.03.2017 (Do)
  • StefanWirrer06.03.17 14:57
  • Listenfeld: Datenstazzeiger positionieren mit ZWEI...
  • nimbu03.03.17 13:21
       └ RE: Listenfeld: Datenstazzeiger positionieren mi... nimbu05.03.17 12:52
  • Funktion VAL
  • Marzer03.03.17 09:52
       └ RE: Funktion VAL PhilS03.03.17 10:27
          └ RE: Funktion VAL Marzer03.03.17 14:36
  • Berichtsausgabe an einen bestimmten PDF-Drucker
  • Herby4915.02.17 14:06
       └ RE: Berichtsausgabe an einen bestimmten PDF-Druc... StefanWirrer16.02.17 14:25
  • Erinnerung: 26. Access-Stammtisch Hannover heute
  • Rookie15.02.17 10:58
  • shell, manche Rechner öffnen nicht
  • Greiff03.02.17 16:32
       └ RE: shell, manche Rechner öffnen nicht Karl Donaubauer03.02.17 17:36
          └ RE: shell, manche Rechner öffnen nicht Greiff04.02.17 18:06
             └ RE: shell, manche Rechner öffnen nicht Karl Donaubauer06.02.17 12:53
                └ RE: shell, manche Rechner öffnen nicht Greiff06.02.17 17:22
                   └ RE: shell, manche Rechner öffnen nicht Karl Donaubauer06.02.17 18:37
                   └ gelöst: shell, manche Rechner öffnen nicht Greiff12.02.17 13:37
  • Einladung zum 26. Access-Stammtisch Hannover am 15...
  • Rookie11.02.17 15:29
  • Access Stammtisch München am 09.02.2017 (Do)
  • StefanWirrer06.02.17 11:02
  • Sicherung gegen Programmierer Ausfall
  • Greiff03.02.17 16:43
       └ RE: Sicherung gegen Programmierer Ausfall PhilS03.02.17 17:06
  • Datensatz von anderem Benutzer geändert
  • Greiff25.01.17 12:52
       └ RE: Datensatz von anderem Benutzer geändert Greiff25.01.17 15:10
       └ RE: Datensatz von anderem Benutzer geändert wilo27.01.17 15:49
       └ gelöst, von anderem Benutzer geändert Greiff03.02.17 16:35
  • Bedingte Formatierung Performance in accde
  • 10302109.11.16 20:07
       └ RE: Bedingte Formatierung Performance in accde PhilS11.11.16 00:28
          └ RE: Bedingte Formatierung Performance in accde 10302111.11.16 18:56
             └ RE: Bedingte Formatierung Performance in accde PhilS12.11.16 09:30
                └ RE: Bedingte Formatierung Performance in accde 10302112.11.16 09:52
                   └ RE: Bedingte Formatierung Performance in... PhilS14.11.16 19:48
                      └ RE: Bedingte Formatierung Performan... 10302115.11.16 17:24
                         └ RE: Bedingte Formatierung Performanc... StefanWirrer16.11.16 09:16
                            └ RE: Bedingte Formatierung Performa... 10302116.11.16 18:34
                               └ RE: Bedingte Formatierung Perfor... sks17.11.16 10:47
                                  └ RE: Bedingte Formatierung Perf... 10302128.11.16 10:44
                                  └ RE: Bedingte Formatierung Perf... 10302128.11.16 10:45
                                     └ RE: Bedingte Formatierung Pe... 10302103.02.17 12:54
  • Anlagen/Bilder speichern
  • isabella31.01.17 17:16
       └ RE: Anlagen/Bilder speichern StefanWirrer01.02.17 08:46
  • Formular- Daten automatisch übernehmen
  • pitken5709.01.17 18:40
       └ RE: Formular- Daten automatisch übernehmen pitken5714.01.17 14:07
       └ RE: Formular- Daten automatisch übernehmen pitken5714.01.17 14:15
       └ RE: Formular- Daten automatisch übernehmen StefanWirrer24.01.17 16:51
          └ RE: Formular- Daten automatisch übernehmen pitken5725.01.17 19:15
             └ RE: Formular- Daten automatisch übernehmen StefanWirrer27.01.17 09:43
                └ RE: Formular- Daten automatisch übernehmen pitken5727.01.17 13:12
                   └ RE: Formular- Daten automatisch übernehmen pitken5727.01.17 15:22
                   └ RE: Formular- Daten automatisch übernehmen StefanWirrer27.01.17 16:21
                      └ RE: Formular- Daten automatisch übernehmen pitken5729.01.17 17:19
                         └ RE: Formular- Daten automatisch übernehmen StefanWirrer31.01.17 12:38
                            └ RE: Formular- Daten automatisch übernehmen pitken5731.01.17 16:02
  • Kumulierte Werte in Abfrage erzeugen?
  • LKro197623.01.17 21:09
       └ RE: Kumulierte Werte in Abfrage erzeugen? Karl Donaubauer24.01.17 17:53
          └ RE: Kumulierte Werte in Abfrage erzeugen? LKro197624.01.17 20:41
    103021
    Gesendet: 15.11.16 17:24
    Betreff: RE: Bedingte Formatierung Performance in accde


    Member

    Beiträge: 12

    Servus PhilS,

    vielen Dank für Deine Rückmeldung.
    Hier mein Code, dieser ist sicher auch noch zu optimieren:

    Option Compare Database
    Option Explicit

    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Public Function BedingteFormatierungMehrAls50()

    Dim vProgressTitel As String
    Dim vZählerP As Long
    Dim vAnzahlGesamt As Long
    Dim lngSchriftfarbe, lngSchriftfarbe1, lngSchriftfarbe2, lngSchriftfarbe3 As Long
    Dim lngIndex As Long
    Dim Obj As Object
    Dim Frm As Form
    Dim ctl As Control
    Dim i As Integer
    Dim Start As Date
    Dim objFormatCondition As FormatCondition
    Dim datStart As Date
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Set db = CurrentDb


    Dim sngStart As Single
    Dim sngDauer As Single

    On Error GoTo Fehler

    sngStart = GetTickCount


    lngSchriftfarbe = DLookup("SchriftFarbe", "tbl_Status", "Wert=0")
    lngSchriftfarbe1 = DLookup("Schriftfarbe1", "tbl_Optionen")
    lngSchriftfarbe2 = DLookup("Schriftfarbe2", "tbl_Optionen")
    lngSchriftfarbe3 = DLookup("Schriftfarbe3", "tbl_Optionen")


    DoCmd.OpenForm "frmPlan", , , , , acHidden
    DoCmd.Hourglass True
    Echo False

    Form_frmPlan.RecordSource = "tblPlan2"
    Set Obj = Forms("frmPlan")

    Dim x As Integer
    x = 0
    For Each ctl In Obj.Section(0).Controls
    x = x + 1
    Debug.Print x & " " & ctl.Name & " " & Now()
    If ctl.ControlType = acTextBox And ctl.Name Like "txtItem*" Then

    Do While ctl.FormatConditions.Count > 0
    ctl.FormatConditions(0).Delete
    Loop

    For i = 1 To 4
    Set objFormatCondition = ctl.FormatConditions.Add(acFieldValue, acEqual, 1)
    Next i

    i = 0


    Set rst = db.OpenRecordset("SELECT * FROM tbl_Status WHERE Status Not like 'Briefkopf'", dbOpenDynaset, dbSeeChanges)

    Do While Not rst.EOF
    lngIndex = Mid(ctl.Name, 8)
    i = i + 1
    Debug.Print x & " " & ctl.Name & " " & Now()
    'Sonderstatus
    Set objFormatCondition = ctl.FormatConditions.Add(acExpression, , "[" & "Item" & lngIndex & "] = " & rst!Wert & " and [" & "ItemSon" & lngIndex & "] = -1")

    With objFormatCondition
    .BackColor = DLookup("Farbe", "tbl_Status", "Wert=" & rst!Wert)
    .ForeColor = lngSchriftfarbe 'DLookup("SchriftFarbe", "tbl_Status", "Wert=0")
    '.FontBold = 0 'DLookup("Fett", "tbl_Status", "Wert=0")
    End With

    If DLookup("ErweiterteSchriftfarbenVerwenden", "tbl_Optionen") = True Then
    ' 'Sonderstatus1
    Set objFormatCondition = ctl.FormatConditions.Add(acExpression, , "[" & "Item" & lngIndex & "] = " & rst!Wert & " and [" & "ItemSon" & lngIndex & "] = 1")

    With objFormatCondition
    .BackColor = DLookup("Farbe", "tbl_Status", "Wert=" & rst!Wert)
    .ForeColor = lngSchriftfarbe1 'DLookup("Schriftfarbe1", "tbl_Optionen")
    '.FontBold = 0 'DLookup("Fett", "tbl_Status", "Wert=0")
    End With

    ' 'Sonderstatus2
    Set objFormatCondition = ctl.FormatConditions.Add(acExpression, , "[" & "Item" & lngIndex & "] = " & rst!Wert & " and [" & "ItemSon" & lngIndex & "] = 2")

    With objFormatCondition
    .BackColor = DLookup("Farbe", "tbl_Status", "Wert=" & rst!Wert)
    .ForeColor = lngSchriftfarbe2 'DLookup("Schriftfarbe2", "tbl_Optionen")
    '.FontBold = 0 'DLookup("Fett", "tbl_Status", "Wert=0")
    End With

    'Sonderstatus3
    Set objFormatCondition = ctl.FormatConditions.Add(acExpression, , "[" & "Item" & lngIndex & "] = " & rst!Wert & " and [" & "ItemSon" & lngIndex & "] = 3")

    With objFormatCondition
    .BackColor = DLookup("Farbe", "tbl_Status", "Wert=" & rst!Wert)
    .ForeColor = lngSchriftfarbe3 'DLookup("Schriftfarbe3", "tbl_Optionen")
    '.FontBold = 0 'DLookup("Fett", "tbl_Status", "Wert=0")
    End With
    End If

    'Normal
    Set objFormatCondition = ctl.FormatConditions.Add(acExpression, , "[" & "Item" & lngIndex & "] = " & rst!Wert & " and [" & "ItemSon" & lngIndex & "] = 0")

    With objFormatCondition
    .BackColor = DLookup("Farbe", "tbl_Status", "Wert=" & rst!Wert)
    End With

    If i <= 4 Then
    ctl.FormatConditions(0).Delete
    End If
    rst.MoveNext



    Loop
    End If
    Next ctl


    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing


    ' Form_frmPlan.RecordSource = "tblPlan2"
    ' Form_frmPlan.RecordSource = "tblPlan"
    Form_frmPlan.Visible = True
    Echo True
    DoCmd.Hourglass False

    sngDauer = Format(GetTickCount - sngStart, "##,##0")

    MsgBox "Dauer: " & Format(sngDauer / 86400000, "hh:mm:ss") & "," & sngDauer Mod 1000


    Exit Function
    Fehler:
    BedingteFormatierungMehrAls50 = False
    End Function
    Top of the page Bottom of the page


    Seite: < 12 13 14 15 16 17 ... 18 19 20 21 22 23 24 ... >
    Suche in diesem Forum
    Druckfreundliche Version
    (Alle Cookies von dieser Seite löschen.)