[Løst] Passord mens makro kjører

[Trelkrok]

Hei igjen. Jeg kjører blant annet denne makroen. Det jeg ønsker er for eksempel passord "1234".

Passord skal settes automatisk mens makro kjører men slå seg på igjen når makro er ferdig. Dette for og hindre endringer i formler som ligger i Pakkseddel. Det vil si at jeg ønsker og bruke Passord KUN ved endring av formler.

Noen som kan hjelpe? 

 

RA

 

 

 

Sub BokføreLagrePDFogKlargjøreNyPakkseddel()

 

Application.ScreenUpdating = False 'skjule hva som skjer

Application.Calculation = xlCalculationManual 'Excel regner ikke ut

    ActiveSheet.Unprotect

    Sheets("Bokføring").Select

    ActiveSheet.Unprotect

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

DoEvents

 

Dim Src As Worksheet 'innskrivningsark

 

Dim Trg As Worksheet 'ark det overføres til

 

Dim Rsrc As Long 'rad det overføres fra

 

Dim Rtrg As Long 'rad det skrives til

 

Dim C As Long

 

 

 

Set Src = ThisWorkbook.Sheets("Pakkseddel") 'endre til rett arknavn

 

Set Trg = ThisWorkbook.Sheets("Bokføring") 'endre denne også

 

 

Range("A63:AT63").Select

    Selection.Copy

    Sheets("Bokføring").Select

    Range("A2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Sheets("Pakkseddel").Select

    

DoEvents

 

Rsrc = ActiveCell.Row 'A2

 

Rtrg = Trg.Cells(Trg.Rows.Count, 1).End(xlUp).Row + 1 'ledig rad under

 

For C = 1 To 60 'kolonne A tom AW

 

    Trg.Cells(Rtrg, C).Value = Src.Cells(Rsrc, C).Value

    

    DoEvents

    

    Next

 

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

        False

    Sheets("Bokføring").Select

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

        False

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

    ActiveWindow.SmallScroll Down:=-24

DoEvents

  

 

 

 

'Lagre Pakkseddel

Dim Sti As String

Dim Filnavn As String

 

Sti = ActiveWorkbook.Path & "\"

Filnavn = "Pakkseddel_" & Cells(7, 6)

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        Sti & Filnavn, Quality:= _

        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

        OpenAfterPublish:=Aapne

DoEvents

 

'

    

 

'Gjøre klar til ny Pakkseddel

 

'

    ActiveSheet.Unprotect

    Sheets("Bokføring").Select

    ActiveSheet.Unprotect

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

Dim t As Integer

t = [J2] + 1

Range("j2").Value = t

 

'

    Range("B10:F10").ClearContents

    Range("K13").ClearContents

    Range("B18:B36").ClearContents

    Range("C18:C36").ClearContents

    Range("D18:D36").ClearContents

    Range("F44:F48").Select

    Selection.ClearContents

    Range("B7:C7").Select

'

DoEvents

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

        False

    Sheets("Bokføring").Select

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

        False

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

    

    MsgBox "Pakkseddel er opprettet :)Har du glemt urskrift finner du PDF filen i mappa :)"

     

     Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

    Application.ScreenUpdating = True 'viser hva som skjer igjen

DoEvents

Application.Calculate

DoEvents

 

ActiveWorkbook.Save

End Sub

Endret 19. juli 2016 av Trelkrok

[Harald Staff]

Du kan sette beskyttelse til å bare gjelde folk, ikke kode. Sjekk denne

http://www.excel-it.com/excel_userinterfaceonly.html

 

Beste hilsen Harald

[Trelkrok]

Du kan sette beskyttelse til å bare gjelde folk, ikke kode. Sjekk denne

http://www.excel-it.com/excel_userinterfaceonly.html

 

Beste hilsen Harald

Takk for tips  , Skal se om jeg får til dette 

Ha en fin da

 

RA

Endret 20. juli 2016 av Trelkrok