[Hartkeksleckereien] Der Keks wird hart mit Steam

[Theoden]

Es wird aber doch hoffentlich etwas sein, wofür man nicht erst programmieren lernen muss.

[Horgan]

DAS dürfte dann jetzt auch zu spät dafür sein.

[Kaiser Martos]

Meine größte Angst ist ja das Horgan wirklich Hoi3 Invasion der Hartkekse sehen will, ihm das Spiel aber nicht gefallen wird weil er da immer auf die Mütze kriegen würde, und ich dann anstatt mich mit nem 10 Euro Steamspiel zu Vergnügen ich vor Hartkeksbeschuss in Deckung gehen müsste.

[Horgan]

Der zweite Durchgang startet

am
24.02.2012

zwischen
18 und 22 Uhr

stattfinden, sofern mir nichts Unvorhergesehenes dazwischen kommt. Zu gewinnen gibt es:

Download(s) im Wert von bis zu

---

Kleiner Tipp:
Es wird sich dieses Mal nicht um Personen, Orte, Geschichte, Spiele, Religion, ... drehen, sondern um

Spoiler (Öffnen)

Mensch, jetzt bin ich doch glatt zu früh dran.. ..na dann schiebe ich das mal noch bis nachher auf.

[Horgan]

Sodele, Ladies & Gentlemen... ...holt Euch die bis zu 25 EUR in Form von Steamprodukten. Die/Der Erste, wo die 2 Aufgaben löst, hat gewonnen.

---

Aufgabe:

1. Beschreibe zu jedem Spoiler kurz, was dort passiert (bspw. "Es soll eine Datenbank geöffnet und Daten ausgelesen werden. In einem Userform/Forumlar sollen dann Name, Hartkekskonsum und Bonität hinterlegt werden." usw. ...).
2. Finde 5 versteckte Fehler und beschreibe, was genau der Fehler ist bzw. wie es hätte richtig heißen müssen.

Arbeitsmappe (Öffnen)

Code: Alles auswählen

Private Sub Workbook_Open()
    Call Anwendungsstart
End Sub

Anwendungsstart (Öffnen)

Code: Alles auswählen

Sub Anwendungsstart()
    If Application.ActiveWorkbook.Name <> "_Vertragssperrenmanagement.xlt" Then
        If VertragssperrenmanagementUF.Visible = True Then VertragssperrenmanagementUF.Hide
        Call Benutzer
        If Bearbeiter = "xxxA" Or _
           Bearbeiter = "xxxB" Then
            AdminlevelUF.KombiAdminListeBenutzer.AddItem Bearbeiter
            Call AdminBenutzerwahlermittlung
            AdminlevelUF.Show
        End If
        VertragssperrenmanagementUF.Anwenderinfo_Benutzer.Caption = Bearbeiter
        VertragssperrenmanagementUF.SperrgrundErfasser.Caption = "   " & Bearbeiter
        Call BenutzerStati
        Call AnwendungsStati
        Call MITGrundLesen
        Call OHNEGrundLesen
        VertragssperrenmanagementUF.Show
    End If
End Sub

AdminBenutzerwahlermittlung (Öffnen)

Code: Alles auswählen

Public cnAdmUser As ADODB.Connection
Public rsAdmUser As ADODB.Recordset
Public sqlStringAdmUser As Variant

Sub AdminBenutzerwahlermittlung()
    sqlStringAdmUser = "SELECT Login FROM sysSBzuTeamZuordnung ORDER BY Login"
   
    Set cnAdmUser = New ADOBC.Connection
   
    With cnAdmUser
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Pfad, "admin", ""
    End With
       
    Set rsAdmUser = New ADODB.Recordset
    On Error Resume Next
   
    With rsAdmUser
        .CursorLocation = adUseClient
        .Open Source:=sqlStringAdmUser, ActiveConnection:=cnAdmUser
        .MoveFirst
    End With
   
    Do While rsAdmUser.EOF = False
        If rsAdmUser.Fields("Login").Value <> "inaktiv" And _
           rsAdmUser.Fields("Login").Value <> Bearbeiter Then
            AdminlevelUF.KombiAdminListeBenutzer.AddItem rsAdmUser.Fields("Login").Value
        End If
        rsAdmUser.MoveNext
    Loop
   
    rsAdmUser.Close
    cnAdmUser.Close
End Sub

Benutzerermittlung (Öffnen)

Code: Alles auswählen

Private Declare Funktion GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
                         (ByVal lpBuffer As String, nSize As Long) As Long
       
Public WCDatei As Variant
Public Bearbeiter As String
Public Meldung As Variant

Sub Benutzer()
    WCDatei = ActiveWorkbook.Name
    DateiBearb = ""
    Bearbeiter = User
End Sub

Function User() As String
    Dim UserName As String * 50, Erfolg As Boolean
    Dim UserNameLen As Long
    UserNameLen = 50

    Erfolg = GetUserName(UserName, UserNameLen)
     
    If Erfolg = False Then 'Wenn der Funktionsaufruf fehlschlägt, so soll nichts zurück gegeben werden
        User = ""
    Else:
        User = Left(UserName, UserNameLen - 1)    'Den angemeldeten User zurück geben
    End If
End Function

BenutzerStati (Öffnen)

Code: Alles auswählen

Public cnBenStati As ADODB.Connection
Public rsBenStati As ADODB.Recordset
Public sqlStringBenStati As Variant

Public BenBearbID As Variant
Public BenBeschreibung As Variant
Public BenTeam As Variant
Public BenStandort As Variant


Sub BenutzerStati()
    sqlStringBenStati = "SELECT * FROM sysSBzuTeamZuordnung WHERE (Login = '" & Bearbeiter & "')"
   
    BenBearbID = ""
    BenBeschreibung = ""
    BenTeam = ""
    BenStandort = ""
   
    Set cnBenStati = New ADODB.Recordset
   
    With cnBenStati
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Pfad, "admin", ""
    End With
       
    Set rsBenStati = New ADODB.Recordset
    On Error Resume Next
   
    With rsBenStati
        .CursorLocation = adUseClient
        .Open Source:=sqlStringBenStati, ActiveConnection:=cnBenStati
        .MoveFirst
    End With
   
    If rsBenStati.EOF = False Then
        BenBearbID = rsBenStati.Fields("Bearb-ID").Value
        BenBeschreibung = rsBenStati.Fields("Beschreibung").Value
        BenTeam = rsBenStati.Fields("Team").Value
        BenStandort = rsBenStati.Fields("Standort").Value
    End If
   

    rsBenStati.Close
    cnBenStati.Close
End Sub

AnwendungsStati (Öffnen)

Code: Alles auswählen

Public cnAnwStati As ADODB.Connection
Public rsAnwStati As ADODB.Recordset
Public sqlStringAnwStati As Variant

Sub AnwendungsStati()
    sqlStringAnwStati = "SELECT * FROM sysAnwStati"
   
    Set cnAnwStati = New ADODB.Connection
   
    With cnAnwStati
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
    End With
       
    Set rsAnwStati = New ADODB.Recordset
    On Error Resume Next
   
    With rsAnwStati
        .CursorLocation = adUseClient
        .Open Source:=sqlStringAnwStati, ActiveConnection:=cnAnwStati
        .MoveFirst
    End With
   
    VertragssperrenmanagementUF.Anwenderinfo_Benutzer.Caption = _
                                "Login: " & VertragssperrenmanagementUF.Anwenderinfo_Benutzer.Caption & " / " & _
                                "Name: " & BenBeschreibung & " / Team: " & BenTeam & " (" & BenStandort & ") - Version: " & _
                                rsAnwStati.Fields("Version").Value & " vom " & _
                                rsAnwStati.Fields("Angelegt_am").Value & _
                                " - Vertragssperren bis: " & _
                                rsAnwStati.Fields("Daten_bis").Value

    rsAnwStati.Close
    cnAnwStati.Close
End Sub

Function Pfad()
     Pfad = "\\corp.firma.de\_Daten\04_Support\IS-U\Massenänderungen\VT-Freigaben_-Sperren\_Datenbank_u_Übersichten\_zur_Abrechnung_gesperrt.mdb"
End Function


MITGrundLesen (Öffnen)

Code: Alles auswählen

Public cnMGrdLesen As ADODB.Connection
Public rsMGrdLesen As ADODB.Recordset
Public sqlStringMGrdLesen As Variant

Sub MITGrundLesen()
   
    VertragssperrenmanagementUF.ListeMIT.Clear
   
    sqlStringMGrdLesen = "SELECT * FROM Gesammelte_Werke WHERE (SAFI = '" & BenBearbID & "' AND " & _
                                                               "Sperrgrunddetails <> NULL) ORDER BY " & _
                                                               "Geschaeftspartner ASC, Vertragskont ASC, Vertrag ASC"

    Set cnMGrdLesen = New ADODB.Connection

    With cnMGrdLesen
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Pfad, "admin", ""
    End With

    Set rsMGrdLesen = New ADODB.Recordset
    On Error Resume Next

    With rsMGrdLesen
        .CursorLocation = adUseClient
        .Open Source:=sqlStringMGrdLesen, ActiveConnection:=cnMGrdLesen
        .MoveFirst
    End With

    Do While rsMGrdLesen.EOF = True
        VertragssperrenmanagementUF.ListeMIT.AddItem _
            rsMGrdLesen.Fields("Geschaeftspartner").Value & "  " & _
            rsMGrdLesen.Fields("Vertragskont").Value & "  " & _
            rsMGrdLesen.Fields("Vertrag").Value & "  " & _
            rsMGrdLesen.Fields("EnCase Verbrauchstellen ID").Value & "  " & _
            rsMGrdLesen.Fields("Sperrgrunddetails").Value & "  ..."
        rsMGrdLesen.MoveNext
    Loop
   
    rsMGrdLesen.Close
    cnMGrdLesen.Close
End Sub


OHNEGrundLesen (Öffnen)

Code: Alles auswählen

Public cnOGrdLesen As ADODB.Connection
Public rsOGrdLesen As ADODB.Recordset
Public sqlStringOGrdLesen As Variant

Sub OHNEGrundLesen()
   
    VertragssperrenmanagementUF.ListOHNE.Clear
   
    sqlStringOGrdLesen = "SELECT * FROM Gesammelte_Werke WHERE (SAFI = '" & BenBearbID & "' AND " & _
                                                               "Sperrgrunddetails IS NULL) ORDER BY " & _
                                                               "Geschaeftspartner ASC, Vertragskont ASC, Vertrag ASC"

    Set cnOGrdLesen = New ADODB.Connection

    With cnOGrdLesen
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Pfad, "admin", ""
    End With

    Set rsOGrdLesen = New ADODB.Recordset
    On Error Resume Next

    With rsOGrdLesen
        .CursorLocation = adUseClient
        .Open Source:=sqlStringOGrdLesen, ActiveConnection:=cnOGrdLesen
        .MoveFirst
    End With

    Do While rsOGrdLesen.EOF = False
        VertragssperrenmanagementUF.ListOHNE.AddItem _
            rsOGrdLesen.Fields("Geschaeftspartner").Value & "  " & _
            rsOGrdLesen.Fields("Vertragskont").Value & "  " & _
            rsOGrdLesen.Fields("Vertrag").Value & "  " & _
            rsOGrdLesen.Fields("EnCase Verbrauchstellen ID").Value & "  " & _
            rsOGrdLesen.Fields("Sperrgrunddetails").Value & "  ..."
        rsOGrdLesen.MoveNext
    Loop
   
    rsOGrdLesen.Close
    cnOGrdLesen.Close
End Sub


[totalwarzone]

Boah, viel Glück demjenigen welchen. Sieht nach Arbeit aus.

[Horgan]

Nun - 25 EUR.. ..dafür muss ich fast ne Stunde arbeiten.. ..die Aufgabe hier ist aber in max. ner halben Stunde (ist ja Einiges zu schreiben) zu schaffen. Also Preis <> Leistung scheinen angemessen.

[Horgan]

Liebe Community

Im Zuge dessen, dass wir als Team Strategie-Zone unsere bisherige Praxis mit den Contests in der Strategie-Zone auf den Prüfstand stellen und
in Anbetracht der Tatsache, dass hier in den letzten 14 Tagen keine Wortmeldung zu verzeichnen war, wird der Hartkeksbackwett-bewerb eingestellt.

Wir danken für das Interesse am Versuch unseres Dauercontests.

Euer Team Strategie-Zone