Automatisk brugernavn og password

Hvis du skal have det forløbende nummer med i username, skal du nok ud i noget makro programmering og det samme gælder password. Jeg kigger på det og vender tilbage.

Det er helt fint med macro kode, glæder mig til svar :-)

Password delen er næsten klar, men jeg døjer stadigt lidt med den fortløbende nummerering af brugernavnene.

Jeg er ked af det, men det driller altså en del med det fortløbende nummer, så jeg giver det lige en chance til.

Kan man ikke lave en slags count distinkt, så den tæller antallet med samme konto.
Dvs. count distinkt på konto 'MM' giver 4 + 1 altså ny MM skal hedde MM5.
Er det noget der kan bruges?

Her er en mulighed,. men den kræver en hjælpekolonne et sted i regnearket. Jeg har her placeret den i d så du har

Konto, Type, Adgang, , Hjælp, Username, Password.
MM, Kunde, JA
MM, Agent, JA
MM, Kunde, Nej
MM, Kunde, JA
SS, Kunde, JA

I et almindeligt modul skal du nu have følgende kode:

Sub OpretBruger()
For Each c In Selection.Cells

    If UCase(c.Offset(0, -1).Value) = "JA" Then
        If UCase(c.Offset(0, -2).Value) = "KUNDE" Then
            c.Value = c.Offset(0, -3).Value
        ElseIf UCase(c.Offset(0, -2).Value) = "AGENT" Then
            c.Value = c.Offset(0, -3).Value & "_AG"
        End If
    End If
Next c
End Sub

Function OpretPW(nLen As Long) As String
  Dim nRnd As Double
  Dim myPW As String
  Dim AddStr As Boolean

  Randomize
  While Len(myPW) < nLen
      nRnd = Int(Rnd * 75) + 48
      AddStr = False
      Select Case nRnd
        Case 48 To 57 ' Numeric characters
            AddStr = True
        Case 65 To 90 ' Upper case characters
            AddStr = True
        Case 97 To 122 ' Lower case characters
            AddStr = True
        Case Else ' Useless characters
            AddStr = False
      End Select

      If AddStr Then
        myPW = myPW & Chr(nRnd)
        If (Len(myPW) = nLen - 1) And (Asc(Left$(myPW, 1)) < 65) Then
            myPW = Right$(myPW, Len(myPW) - 1)
        End If
      End If
  Wend

  OpretPW = myPW
End Function

Sub Adgang()
lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    For Each c In Selection.Cells
        c.Value = OpretPW(lgd)
    Next c
End Sub

Marker nu de celler i hjælpekolonnen (D) som svarer til antallet af celler i A. Kør makroen Opretbruger. I E-kolonnen indsætter du så denne formel i E2:

=HVIS(D2="";"";D2&TÆL.HVIS($D$2:D2;D2))

Kopier nedad efter behov.

For at oprette password i F-kolonnen marker du også disse celler og kører makroen Adgang.

Nu har du både brugernavne og adgangskoder. Jeg prøver om jeg kan pakke det lidt mere sammen.

Det smuttede lige en linje i en af koderne. Den sidste skulle se således ud

Sub Adgang()
Dim lgd As Long
lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    For Each c In Selection.Cells
        c.Value = OpretPW(lgd)
    Next c
End Sub

Her er en løsning, hvor du kun skal afspille en enkelt makro, for at løse dit problem. Du skal stadig have al den nedenstående kode i et modul. Den makro, du nu skal afspille er Brugernavn_Adgangskode(). Den klarer resten under forudsætning at du har konto i A, type i B og Adgang i C og at der ikke står andet i disse kolonner end det, der skal bruges.

Sub Brugernavn_Adgangskode()
    Dim EndRow As Long
   
    'Først indsættes en hjælpekolonne
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
   
    'Så markeres et område i hjælpekolonnen, der passer til området i A-kolonnen
    EndRow = Range("a65536").End(xlUp).Row
    Range("d2:D" & EndRow).Select
   
    'Det opretes brugernavne uden tæller i hjælpekolonnen
    OpretBruger
   
    'Så tilføjes tælleren i E-kolonnen
    Range("e2:e" & EndRow).Select
    For Each c In Selection.Cells
        c.Formula = "=IF(RC[-1]="""","""",RC[-1]&(COUNTIF(R2C4:RC[-1],RC[-1])))"
    Next c
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
   
    'Hjælpekolonnen slettes igen
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
   
    'Relæevante celler i E-kolonnen vælges
    Range("e2:e" & EndRow).Select
   
    'Der indsættes adgangskoder
    Adgang
End Sub


Function OpretPW(nLen As Long) As String
  Dim nRnd As Double
  Dim myPW As String
  Dim AddStr As Boolean

  Randomize
  While Len(myPW) < nLen
      nRnd = Int(Rnd * 75) + 48
      AddStr = False
      Select Case nRnd
        Case 48 To 57 ' Numeric characters
            AddStr = True
        Case 65 To 90 ' Upper case characters
            AddStr = True
        Case 97 To 122 ' Lower case characters
            AddStr = True
        Case Else ' Useless characters
            AddStr = False
      End Select

      If AddStr Then
        myPW = myPW & Chr(nRnd)
        If (Len(myPW) = nLen - 1) And (Asc(Left$(myPW, 1)) < 65) Then
            myPW = Right$(myPW, Len(myPW) - 1)
        End If
      End If
  Wend

  OpretPW = myPW
End Function



Sub OpretBruger()
For Each c In Selection.Cells

    If UCase(c.Offset(0, -1).Value) = "JA" Then
        If UCase(c.Offset(0, -2).Value) = "KUNDE" Then
            c.Value = c.Offset(0, -3).Value
        ElseIf UCase(c.Offset(0, -2).Value) = "AGENT" Then
            c.Value = c.Offset(0, -3).Value & "_AG"
        End If
    End If
Next c
End Sub



Sub Adgang()
Dim lgd As Long
lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    For Each c In Selection.Cells
        c.Value = OpretPW(lgd)
    Next c
End Sub

Password delen virker fint, borset fra hvis typen er forskellig fra "JA", så bliver der sat password aligevel.
Brugernavn får jeg ikke, hvilken kolonne skal brugernavn have?
Er det ikke muligt at lave tælleren til brugernavn?

I den sidste variant, jeg har lavet har brugernavnet fået en tæller på.

Jeg har Konto i A, Type i B og Adgang i C, Brugernavn i D og Password i E.

Hvis du giver mig en mailadresse, skal jeg sende et eksempel.

msj@missionpharma.com

Hej JKrons
Det spiller bare (super lavet!).
Smid svar for point!
Mvh. Martin

Her er et svar. Og den smalede kode til de, der måtte være interesserede:

Sub Brugernavn_Adgangskode()
    Dim EndRow As Long
   
    'Først indsættes en hjælpekolonne
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
   
    'Så markeres et område i hjælpekolonnen, der passer til området i A-kolonnen
    EndRow = Range("a65536").End(xlUp).Row
    Range("d2:D" & EndRow).Select
   
    'Det opretes brugernavne uden tæller i hjælpekolonnen
    OpretBruger
   
    'Så tilføjes tælleren i E-kolonnen
    Range("e2:e" & EndRow).Select
    For Each c In Selection.Cells
        c.Formula = "=IF(RC[-1]="""","""",RC[-1]&(COUNTIF(R2C4:RC[-1],RC[-1])))"
    Next c
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
   
    'Hjælpekolonnen slettes igen
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
   
    'Relæevante celler i E-kolonnen vælges
    Range("e2:e" & EndRow).Select
   
    'Der indsættes adgangskoder
   
    Adgang
End Sub


Function OpretPW(nLen As Long) As String
  Dim nRnd As Double
  Dim myPW As String
  Dim AddStr As Boolean

  Randomize
  While Len(myPW) < nLen
      nRnd = Int(Rnd * 75) + 48
      AddStr = False
      Select Case nRnd
        Case 48 To 57 ' Numeric characters
            AddStr = True
        Case 65 To 90 ' Upper case characters
            AddStr = True
        Case 97 To 122 ' Lower case characters
            AddStr = True
        Case Else ' Useless characters
            AddStr = False
      End Select

      If AddStr Then
        myPW = myPW & Chr(nRnd)
        If (Len(myPW) = nLen - 1) And (Asc(Left$(myPW, 1)) < 65) Then
            myPW = Right$(myPW, Len(myPW) - 1)
        End If
      End If
  Wend

  OpretPW = myPW
End Function



Sub OpretBruger()
For Each c In Selection.Cells

    If UCase(c.Offset(0, -1).Value) = "JA" Then
        If UCase(c.Offset(0, -2).Value) = "KUNDE" Then
            c.Value = c.Offset(0, -3).Value
        ElseIf UCase(c.Offset(0, -2).Value) = "AGENT" Then
            c.Value = c.Offset(0, -3).Value & "_AG"
        End If
    End If
Next c
End Sub



Sub Adgang()
Dim lgd As Long
lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    For Each c In Selection.Cells
        If UCase(c.Offset(0, -2).Value) = "JA" Then
            c.Value = OpretPW(lgd)
        End If
    Next c
End Sub

Undskyld den lange ventetid, men her er kode, som også burde håndtere, at der kun oprettes nye i en allerede eksisterende liste.

Sub Brugernavn_Adgangskode()

    Dim EndRowA As Long
    Dim EndRowD As Long
    Dim lgd As Long
   
    'Først indsættes en hjælpekolonne
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
   
    'Så markeres et område i hjælpekolonnen, der passer til området i A-kolonnen
    EndRowA = Range("a65536").End(xlUp).Row
    Range("d2:D" & EndRowA).Select
   
    'Det opretes brugernavne uden tæller i hjælpekolonnen
    OpretBruger
   
    'Så tilføjes tælleren i E-kolonnen
    Range("e2:e" & EndRowA).Select
    For Each c In Selection.Cells
        c.Formula = "=IF(RC[-1]="""","""",RC[-1]&(COUNTIF(R2C4:RC[-1],RC[-1])))"
    Next c
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
   
    'Hjælpekolonnen slettes igen
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    EndRowD = Range("d65536").End(xlUp).Row
   
    'Adgangskode oprettes
    Range("D1:D" & EndRowD).Select
    Adgang
   
    End Sub


Function OpretPW(nLen As Long) As String
  Dim nRnd As Double
  Dim myPW As String
  Dim AddStr As Boolean

  Randomize
  While Len(myPW) < nLen
      nRnd = Int(Rnd * 75) + 48
      AddStr = False
      Select Case nRnd
        Case 48 To 57 ' Numeric characters
            AddStr = True
        Case 65 To 90 ' Upper case characters
            AddStr = True
        Case 97 To 122 ' Lower case characters
            AddStr = True
        Case Else ' Useless characters
            AddStr = False
      End Select

      If AddStr Then
        myPW = myPW & Chr(nRnd)
        If (Len(myPW) = nLen - 1) And (Asc(Left$(myPW, 1)) < 65) Then
            myPW = Right$(myPW, Len(myPW) - 1)
        End If
      End If
  Wend

  OpretPW = myPW
End Function



Sub OpretBruger()
    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
    Next c
End Sub



Sub Adgang()
    Dim lgd As Long
    On Error GoTo fejl
    lgd = InputBox("Indtast den krævde længde på adgangskoden og klik OK")
    If lgd = "" Then Exit Sub
        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

Undskyld. Det er kun Adgang og Brugernavn_Adgangskode, der er ændret i.