Brugernavn og adgangskode

I et regneark findes tre kolonner. I den første (A) står fornavne. I den anden (B) står efternavne. I den tredje (C) står Ja, Nej eller den er tom. Vi vil nu gerne have genereret et brugernavn og en adgangskode. Brugernavnet skal bestå af de to første bogstaver i fornavnet, de to første bogstaver i efternavnet og et løbenummer, som er fortløbende for identiske brugernavne, altså fx får den første bruger med bestemte initialer et 1-tal, mens den næste bruger med samme initialer får et 2-tal og så fremdeles. Desuden skal der genereres en tilfældig adgangskode af en nærmere bestemt længde.

Selve genereringen af initialerne kan gøres med:

Sub FindInitialer()
    For Each c In Selection.Cells
        If UCase(c.Offset(0, -1).Value) = "JA" Then
            c.Value = LCase(Mid(c.Offset(0, -3), 1, 2) & Mid(c.Offset(0, -2), 1, 2))
        End If
        c.Value = Replace(c.Value, "æ", "z")
        c.Value = Replace(c.Value, "ø", "q")
        c.Value = Replace(c.Value, "å", "x")
    Next c
End Sub

Da ikke mange systemer kan lide brugernavne, der indeholder æ, ø eller å, erstattes disse med henholdsvis z, q og x.

Generering af løbenummer, vender jeg tilbage til nedenfor. Adgangskoden skal nu genereres. Det har jewg valgt at gøre via en Function, som senere bliver kaldt af en Sub. Kommentarlinjerne skulle forhåbentlig forklarer koden

Function OpretPW(lngd As Long) As String
    Dim dTilf As Double
    Dim sPW As String
    Dim bStreng As Boolean

    'Udvælg tilfældige, tilfældige tal   
    Randomize
    'Udvælg karakterer til adgangskoden
    While Len(sPW) < lngd 'Gentag udvælgelse til den ønskede længde er nået.
        dTilf = Int(Rnd * 75) + 48 'Vælg et tilfældigt heltal mellem 48 og 123.
        bStreng = False 'Sæt værdien af en given karakter til Falsk
        Select Case dTilf
            Case 48 To 57 ' Værdier mellem48 og 57 repræsenterer numeriske værdier
                bStreng = True 'Karakteren sættes til Sand
            Case 65 To 90 'Værdier mellem 65 og 90 repræsenterer store bogstaver
                bStreng = True 'Karakteren sættes til Sand
            Case 97 To 122 'Værdier mellem 97 og 122 repræsenterer små bogstaver
                bStreng = True 'Karakteren sættes til Sand
            Case Else 'De andre tal er ugyldige
                bStreng = False 'Karakteren sættes til Falsk
        End Select

        If bStreng Then 'Hvis værdien er sand, karakteren gyldig, føjes den til adgangskoden
            sPW = sPW & Chr(dTilf)
        'Dette gentages til den ønskede længde af adgangskoden er nået
            If (Len(sPW) = lngd - 1) And (Asc(Left$(sPW, 1)) < 65) Then
                sPW = Right$(sPW, Len(sPW) - 1)
            End If
        End If
    Wend
    'Til sidst oprettes adgangskoden
    OpretPW = sPW
End Function

Nu skal længden af adgangskoden kunne vælges af brugeren. Skrives der ingen længde i inputboksen, vil der blive vist en fejlmeddelelse, og der genereres ingen adgangskode. Der skal kun skrives en adgangskode, hvis der står Ja i C-kolonnen, og E-kolonnen ikke allerede indeholder én. Ellers vil de bestående adgangskoder blive overskrevet, og det er ikke meningen.

Sub Adgang()
    Dim lgd As Long
    On Error GoTo fejl
    lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    For Each c In Selection.Cells
         If UCase(c.Offset(0, -1).Value) = "JA" And c.Offset(0, 1) = "" Then
             c.Offset(0, 1).Value = OpretPW(lgd)
         End If
     Next c
fejl:
    If Err.Number = 13 Then
        MsgBox "Der kunne ikke oprettes en adgangskode, da der ikke blev opgivet en længde.", _
            vbOKOnly + vbExclamation
        Exit Sub
    End If
End Sub

Ovenstående kode viser en inputboks, hvor brugeren kan indtaste længden på adgangskoden. når der klikkes OK i inputboksen, generes adgangskoden.

Til sidst skal det hele "pakkes sammen" i en enkelt makro. Ud over at oprette brugernavn og adgangskode, skal denne også sikre, at der tilføjes en løbenumre til initialerne, så brugernavnene bliver sikre. Endeligt skal den sikre, at såfremt. der kun markeres et enkelt eller få ny brugernavne, bliver adgangskoden ikke ændret, for de brugernavne, der allerede er oprettede. Igen lader jeg kommentarerne "tale" som forklaring.

Sub Brugernavn_Adgangskode()
    'Erklæring af variable
    Dim EndRowA As Long
    Dim EndRowD As Long
    Dim lgd As Long

    Application.Screenupdating = False ' Vi gider ikke se hele skærmopdateringen

    'Først indsættes en hjælpekolonne til venstre for adgangskodekolonnen (som ny D)
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight

    'Så markeres et område i hjælpekolonnen, der passer til området med fornavne i A-kolonnen
    EndRowA = Range("a65536").End(xlUp).Row
    Range("d2:D" & EndRowA).Select

    'Det oprettes brugernavne uden tæller i hjælpekolonnen ved et kald til Sub OpretBruger
    OpretBruger

    'Så tilføjes tælleren i E-kolonnen ved hjælp en formel, der sammensætter
    'Initialerne fra hjælpekolonnen med en TÆL.HVIS() der tæller de enkelte
    'forekomster af hvert initialsæt

    Range("e2:e" & EndRowA).Select ' Her vælges E-kolonnen
    For Each c In Selection.Cells
        c.Formula = "=IF(RC[-1]="""","""",RC[-1]&(COUNTIF(R2C4:RC[-1],RC[-1])))" 'Her indsættes formlen
    Next c

    'Nu kopieres indholdet af E-kolonnen og indsættes samme sted, men som værdier, ikke formler
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues ' Indsæt som værdier

    'Der er nu fortløbende nummerering på identiske initialer i E-kolonnen
    'og hjælpekolonnen (D) slettes igen
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

    'Brugernavn i form af initialer og løbenummer står nu i D-kolonnen
    'Sidste celle i denne findes
    EndRowD = Range("d65536").End(xlUp).Row

    'Adgangskode oprettes i de celler, i E-kolonnen, hvor der ikke allerede står noget, men hvor
    'der står Ja i C-kolonnen
    Range("D1:D" & EndRowD).Select
    Adgang

    'Overskriften i D-kolonnen "spises" måske,
    'så den sætter vi igen for en sikkerheds skyld
    Range("D1").Value = "Brugernavn"

    'Til sidst aktiveres A1 - klar til næste omgang.
    Range("A1").Select

    Application.Screenupdating = True ' Nu må skærmen gerne begynde at opdatere igen
End Sub

Det var temmelig meget kode til en forholdsvis simpel opgave og muligvis kan det gøres meget enklere. Det har jeg endnu ikke haft tid til at se på, men det kommer måske en dag :-)

Til sidst lidt om, hvordan makroerne bruges. Som udgangspunkt har vi følgende data:

For at bruge funktionen markeres nu den tomme kolonne med brugernavne. (Vist med gul farve). Derefter afspilles makroen og denne dialogbox vises:

Når der skrives et tal i dialogboksen (her tallet 8), genereres brugernavne og adgangskoder.

Skal man senere oprette en eller flere nye tilføjes denne/disse nederst, og brugernavnene markeres separat. Ændrer man ved en senere lejlighed Else Stickelberg fra Nej til Ja, skal hendes navn også flyttes nederst. Ellers får hun nummer 2 og Elsa Stikestad får nummer 3, hvilket ikke er hensigtsmæssigt. Også dette problem kan løses ved hjælp af makroer, og det vil jeg nok tilføje til artiklen en anden gang.

- Til top -
- Tilbage til makroer -
- Tilbage til Excel -