CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

barentsen Novice

21. august 2008 - 11:36 Der er 13 kommentarer og
1 løsning

Arkbeskyttelse på flere ark vha Makro

Dette spørgsmål er en fortsættelse på spørgsmålet http://www.eksperten.dk/spm/842171 fra "tvc" den 19. august.
Det var nemlig lige noget jeg kunne bruge....

Løsningen (makroen) på ovenstående spørgsmål har jeg kopieret ind nederst.

Mit spørgsmål:
Makroen herunder spørger om man vil fjerne beskyttelsen på alle ark? (Jeg har lavet en makro "magen til" som bare låser i stedet for)
Jeg kunne godt bruge, at man i stedet får en "checkbox" hvor man kan markere de ark man ønsker åbnet/låst, så det kun er de valgte der bliver åbnet/låst.

Ex. en fil med 10 ark (Ark1 - Ark10).
Ved at aktivere makroen skal der komme en "checkboks" med mulighed for at sætte markering ud for Ark1, Ark2, Ark3 osv.
Det er så kun de markerede ark der skal åbnes/låses.

Er der nogen der kan klare det?

"Nuværende makro/svar fra det omtalte spørgsmål":
Der er lidt "ballade" når man har valgt flere ark - og gerne vil unprotect. Så man bliver nødt til at "un-group" og bagefter "re-group"... Det er alt sammen herunder:

Sub unprotect()
Dim vsheet As Worksheet
Dim pw As String
Dim shts As Sheets
Set shts = ActiveWindow.SelectedSheets
'Un-group
ActiveSheet.Select
answ = MsgBox("Fjern beskyttelsen fra alle ark?" & vbLf & vbLf & "'Ja': Alle ark" & vbLf & "'Nej': Valgte ark", vbQuestion + vbYesNoCancel)

If answ <> vbCancel Then
pw = InputBox("Indtast password", "Password")
If answ = vbYes Then
For Each vsheet In Sheets
vsheet.unprotect pw
Next
Else
For Each vsheet In shts
vsheet.unprotect pw
Next
End If
End If
'Re-group
shts.Select

End Sub

Synes godt om

sager Nybegynder

21. august 2008 - 15:18 #1

Det skulle jeg mene jeg godt kan, men lige et par spørgsmål først.
Er der et bestemt antal ark der maks kan være? (nødvendigt at vide hvis det skal laves med checkbokse)
Alternativt kunne man bruge en listbox med ark-navne, og her kan man så ved at holde ctrl nede vælge de ark der skal beskyttes. Hvordan lyder den løsning?

Synes godt om

barentsen Novice

21. august 2008 - 15:32 #2

Det lyder godt, hvis du kan hjælpe med dette.

Løsningen med listbox kan jeg leve med, men det virker umiddelbart mere korrekt hvis det kan være checkbokse.
Jeg har pt. max 11 ark, men der vil nok godt kunne blive tilføjet et par ark mere, så hvis den kan håndtere 14 ark, så opfylder den i hvert fald mit behov.

Synes godt om

kabbak Professor

21. august 2008 - 17:01 #3

Et eksempel:

Lav en userform, med en Listboks (Listbox1) og 2 command knapper ( Beskyt) og (Ubeskyt)

Option Explicit

Private Sub CommandButton1_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).protect Password:=PW
End If
Next
End Sub

Private Sub Ubeskyt_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).unprotect PW
End If
Next
End Sub

Private Sub UserForm_Initialize()
Dim Sh As Worksheet
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1 = Empty
For Each Sh In ActiveWorkbook.Sheets
ListBox1.AddItem Sh.Name
Next
End Sub

Synes godt om

kabbak Professor

21. august 2008 - 17:02 #4

ption Explicit

Private Sub Beskyt_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).protect Password:=PW
End If
Next
End Sub

Private Sub Ubeskyt_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).unprotect PW
End If
Next
End Sub

Private Sub UserForm_Initialize()
Dim Sh As Worksheet
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1 = Empty
For Each Sh In ActiveWorkbook.Sheets
ListBox1.AddItem Sh.Name
Next
End Sub

Synes godt om

barentsen Novice

21. august 2008 - 22:09 #5

Kabbak, jeg har brug for lidt hjælp til at lave "Userform med listbox og 2 command knapper" som du skriver jeg skal lave.
Det har jeg ikke prøvet at lave før via MVB.

Synes godt om

kabbak Professor

21. august 2008 - 22:44 #6

Åben din excel mappe, den det skal virke i.

tryk ALT +F11

Nu er du i VBA editoren

Vælg Insert > Userform

Nu skulle værktøjet også komme frem

indsæt listboksen (Listbox1)og de 2 commandbuttens

omdøb knapperne og ret teksten på dem til ( Beskyt) og (Ubeskyt)
det gøres i den nederste boks til højre, som hedder Properties, se på navnet efter, det er det aktive object.

Navnet skal stå ud for (Name) og teksten på knappen skal stå ud for Caption.

Sæt så min kode ind i Userform modulet

Lav så en almindelig makro, som er i et module, Vælg Insert > Module,
den bruger du til at starte userformen med.

Public Sub VisForm()

userform1.show
end sub

Synes godt om

barentsen Novice

22. august 2008 - 10:28 #7

Et lille problem:

Når jeg kører makroen gør den sådan set som ønsket, dog forsvinder Listboxen ikke når man har åbnet/låst - så man er tvunget til at lukke den igen vha. x'et i hjørnet for at fjerne boxen.
Kan den laves, så boxen forsvinder når man trykker ok/cancel i password-boxen?

Synes godt om

sager Nybegynder

22. august 2008 - 10:54 #8

Tilføj:
"Unload Userform1"
som det sidste.

(hvis altså userformen hedder Userform1)

Synes godt om

kabbak Professor

22. august 2008 - 12:01 #9

Option Explicit

Private Sub Beskyt_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).Protect Password:=PW
End If
Next
Unload Me
End Sub

Private Sub Ubeskyt_Click()
Dim X As Integer, PW As String
PW = InputBox("Indtast password", "Password")
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) Then
Worksheets(ListBox1.List(X)).Unprotect PW
End If
Next
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim Sh As Worksheet
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1 = Empty
For Each Sh In ActiveWorkbook.Sheets
ListBox1.AddItem Sh.Name
Next
End Sub

Synes godt om

barentsen Novice

22. august 2008 - 12:56 #10

Kabbak: det virker som det skal...
Tak for hjælpen - smid et svar

sager: Kabbak hjalp med stort set hele opgaven, og har også tilhøjet den sidste ændring i hans svar, så han får altså pointene, håber det er ok.

Synes godt om

kabbak Professor

22. august 2008 - 13:10 #11

et svar ;-))

Synes godt om

sager Nybegynder

22. august 2008 - 13:21 #12

selvfølgelig er det det...

Synes godt om

JeppeH Juniormester

02. februar 2010 - 19:56 #13

Hej Kabbak & Sager,

Jeg har lavet et opfølgende indlæg til denne tråd. Håber at I har lyst til at deltage.

Barentsen @ Det er temmelig sikkert noget du også kan bruge ;o)

Venlig hilsen

Jeppe

Synes godt om

JeppeH Juniormester

02. februar 2010 - 19:56 #14

Nu MED link! ;o)

http://www.eksperten.dk/spm/900400

Synes godt om

Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Følg dette spørgsmål

Opret Preview

Excel kurser

Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Betinget formatering Af Ninna i Excel	1	23/07/202413:03	23/07/202419:56
Opdater et ark Af lurup i Excel	2	22/07/202422:23	23/07/202416:41
Dato skema Af Ninna i Excel	7	22/07/202414:58	23/07/202419:55
Betinget formatering Af boro23 i Excel	8	22/07/202410:58	I dag 07:47
Problem med beregning af alder udfra cpr-nummer; formel giver talfejl pga. nul i CPR Af HR Excel-bruger i Excel	6	16/07/202416:31	17/07/202408:36

Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten

Seneste artiklerRSS