Lösenord taget från cell in till VBA kod

[Michael Lust]

Hej

Jag har idag gjort en kod där man kan öppna andra låsta arbetsböcker. och det fungerar bra, men jag vill att användarna ska kunna ändra lösenordet själva och att jag lägger in de i mitt blad så koden styr mot den cellen, så slipper jag gå in  i VBA och ändra koden varje gång. Även bladet där cellen är måste väl med?

Går det att ordna på något vis

 

Idag sitter lösenordet på samma rad som sökvägen till filen.

Jag har 30st ark och lösenord att hålla reda på, så det vore smidigt om det gick att ordna.

 

Tacksam för hjälp

 

Michael

[Monshi]

Ja, det går utmärkt att spara lösenord i en cell om du vill. var dock medveten om att lösenordet är mycket svagt skyddat, det går ganska enkelt att ta fram dolda cellers värden eller även värden på dolda blad.

 

men kanske inte så farligt?

man kan alltid "kryptera" det lite enkelt om man vill det.

 

Enklaste lösningen är att poppa upp en dialog i stil med

Sub LösenKoll()
    Dim rnPwd As Range
    Dim answ As String
    Set rnPwd = Blad1.Range("a1")
    answ = InputBox("Ange nuvarande lösenord", "Ändra lösen")
    If answ <> rnPwd Then
        MsgBox "Felaktigt lösenord", vbCritical
        Exit Sub
    End If
    answ = InputBox("Ange nytt lösenord", "Ändra lösen")
    If answ = "" Then
        MsgBox "Lösenord ej ändrat", vbInformation
    Else
        rnPwd = answ
    End If
End Sub

Ändra om så att koden ovan tar cellen med lösenordet i som argument och ha en annan rutin som tar reda på vilken lösenord det är som ska ändras.

 

 

Kryptera?

En mycket enkel skiftning av tecken enbart:

Public Sub EncryptDecrypt(ByRef szData As String)

    Const lKEY_VALUE As Long = 215
    
    Dim bytData() As Byte
    Dim lCount As Long
    
    bytData = szData
    
    For lCount = LBound(bytData) To UBound(bytData)
        bytData(lCount) = bytData(lCount) Xor lKEY_VALUE
    Next lCount

    szData = bytData
    
End Sub

bara så de inte står i klartext. Skicka strängen igenom en gång för att "kryptera", en gång för att "avkryptera"

[Michael Lust]

Hej

Jag är så otroligt tacksam för ditt svar. Kommer att lägga in det här så fort jag hinner.

 

En undran bara. ar i makrot ska jag lägga in koden. Här är e kod som jag gjort.

 

Sub persuppgtillkort()

'

' persuppgtillkort Makro

'

 

'

'

    intSvar = MsgBox("Vill du överföra personinfo till personkort 1001.", vbYesNoCancel, "Överföring")

    If intSvar = vbYes Then

'   Förhindra att bilden uppdateras medan makro körs.

    Application.ScreenUpdating = False

    ActiveSheet.Unprotect

    Range("O5:S5").Select

    Workbooks.Open Filename:="C:\Users\Michael\Documents\schema\1001.xlsm", Password:="1001", UpdateLinks:=3

    Sheets("schema").Select

    Range("O2").Select

    Windows("1.SCHEMAPROGRAM.xlsm").Activate

    Range("O5:V5").Select

    Selection.Copy

    Windows("1001.xlsm").Activate

    Sheets("schema").Select

    Range("O2").Select

    ActiveSheet.Paste

    Sheets("Blad1").Select

    ActiveWorkbook.Save

    ActiveWindow.Close

    Application.CutCopyMode = False

    Range("N5").Select

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

    Application.ScreenUpdating = True

    MsgBox "Överföringen klar."

ElseIf intSvar = vbNo Then

Else

End If

End Sub

 

 

Hoppas du förstår vad jag menar.

Det här är ett ark jag uppdaterar. I vissa makron ligger arken var för sig utan samlat i ett makro. Men det kanske inte spelar någon roll.

Jag är irriterande novis på det här men tycker det är väldigt roligt nu när man börjar skumma lite på ytan.

 

Michael

[Michael Lust]

Sen är det inte så allvarliga saker i de här arken. De användare ja har klarar sig alldeles utmärkt med den här nivån.

 

Tycker ändå att om en användare vill ha ett eget lösenord så vill jag ha ett enkelt sätt att hantera det på.

 

Ska prova krypteringen ändå. Kul grej helt enkelt..

 

Återigen Tack!

[Monshi]

Ojoj, en massa Select och Activate... inspelad kod?

ta en titt i denna tråd:

//eforum.idg.se/topic/220943-riktlinjer-f%C3%B6r-bra-vba-kod/

 

Men vi ändra

Sub LösenKoll()
    Dim rnPwd As Range

till

Sub LösenKoll(rnPwd as Range)

När du har en referens till cellen med lösenordet (jag kan inte se var i koden du har det) anropa koden ovan helt enkelt.

 

fast var det sker.. mmh, en dialog om lösenordet ändrats? Ja du vet bäst vad din kod gör.

[Michael Lust]

Hej

Japp, det är inspelat som en gammal bandspelare. Tyvärr sträcker sig min kunskap om VBA inte så mycket längre än så. Jag har klarat mig ganska bra ändå, tills nu. =) Tycker att de makron jag har gjort inte slöat ner datorn något nämnvärt.

Den koden jag skickade var att överför ett schema till ett annat Excel ark, ingen kodat till speciellt ställe där jag sparar lösenord. Tänkte lägga in den i din kod där vid Blad1 etc...

Just nu har jag liksom bara skrivit in lösenordet direkt, och det funkar, när jag öppnar filen så här;

 

Filename:="C:\Users\Michael\Documents\schema\1001.xlsm", Password:="1001", UpdateLinks:=3

 

Har provat nu men får inte riktigt till det.

Vill ju lägga in den här koden i mitt makro. Hur gör jag?

Sen finns det 30st filer, alltså fram till 1030, som jag har lagt ihop till ett makro. Behöver jag lägga in det för varje fil, vilket låter logiskt i och för sig.

 

Hopplöst okunnig

 

Michael

[Monshi]

Ojoj, det låter som vi får göra om din kod en del.

 

Fick intrycket i ditt första inlägg att du hade en lista med böcker, som du stegade igenom, och bredvid filnamnet ville du notera lösenordet?

 

Nåja, med ett/två frågetecken i koden har jag kondenserat den ned till

Sub persuppgtillkort()

    Dim rnData As Range
    Set rnData = Blad1.Range("A1").CurrentRegion 'din datatabell, namn på post i A, sökväg i B, lösen i C. Rubrikrad på rad 1
    Dim i As Integer
    Dim intSvar As Integer
    Dim wbData
    For i = 2 To rnData.Rows.Count
    
        intSvar = MsgBox("Vill du överföra personinfo till personkort " & rnData.Cells(i, 1) & "?", vbYesNoCancel, "Överföring")
        If intSvar = vbYes Then
            'Förhindra att bilden uppdateras medan makro körs.
            Application.ScreenUpdating = False
          '  Worksheets("Blad2").Unprotect '??
            Set wbData = Workbooks.Open(Filename:=rnData.Cells(i, 2), Password:=rnData.Cells(i, 3), UpdateLinks:=3)
           ' Worksheets("schema").Range("O5:V5").Copy '' denna arbetsbok, datablad???
            'eller
            'worksheets("Blad2).Range("O5:V5").Copy  '??
            wbData.Worksheets("schema").Range("02").PasteSpecial xlPasteAll
            wbData.Close True
            
            Application.CutCopyMode = False
            
            
            Application.ScreenUpdating = True
            MsgBox "Överföringen klar."
        End If
        If intSvar = vbCancel Then Exit Sub
    Next i
End Sub

Bara lite tvetydigt vilket blad som är källan och varför du behöver ta bort skyddet på bladet du kopierar från. Det är borta ur koden...

Lösenordet inte krypterat i denna version av koden.