• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

beveiliging opheffen van een door macro geopend bestand

Status
Niet open voor verdere reacties.

gammelkeunited

Gebruiker
Lid geworden
6 mrt 2008
Berichten
36
hallo mensen,

ik heb een programmaatje gemaakt dat aan de hand van een nummer in een excel bestand, een ander excel bestand opend. in dit bestand word wat gekopieerd en geplakt, en dan word er een waarde uitgehaald.
echter dit bestand is beveiligd. nu wil ik in de macro deze beveiliging opheffen en na het kopieren en plakken de beveiliging er weer opzetten.

ik heb het geprobeerd met sheet.unprotect en workbook userface unprotect = true. en een aantal varianten hierop maar ik krijg steeds een aantal foutmeldingen.

dit is de code
Private Sub CommandButton1_Click()
Dim lRij As Long
lRij = 2

While Range("A" & lRij).Value <> ""
If Dir("H:\Ontwikkeling" & Range("A" & lRij).Value & ".xls") <> "" Then
Application.ScreenUpdating = False
Workbooks.Open "H:\Ontwikkeling\" & Range("A" & lRij).Value & ".xls"
Sheets("Verkoop").Activate
ActiveSheet.[C4:C150].Select
Selection.Copy
ActiveSheet.[N4:N150].Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Sheets("Totaal").Activate
ActiveSheet.[A1].Select
Selection.Copy
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Range("F" & lRij).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Workbooks(Workbooks.Count).Close savechanges:=False
lRij = lRij + 1
Application.ScreenUpdating = True
Else
lRij = lRij + 1
Application.ScreenUpdating = True
End If

Wend
End Sub


wie kan mij helpen?

BVD

met vriendelijke groet,
Gammelkeunited
 
Beste gammelkeunited ;)

Ken je het paswoord ?

Zoniet, ga dan naar deze topic


Groetjes Danny. :thumb:
 
Hallo Danny,

de bestanden zijn niet beveiligd met een wachtwoord.

ze zijn enkel beveiligd via -extra -beveiligen -blad beveiligen
de volgende opties zijn aangevinkt :
-vergrendelde cellen selecteren
-ontgrendelde cellen selecteren
-celeigenschappen
-autofilter gebruiken.

iedere gebruiker zou deze beveiliging eraf kunnen halen

met vriendelijke groet,
gammelkeunited
 
Niet getest!
Code:
Private Sub CommandButton1_Click()
Dim lRij As Long
    lRij = 2
While Range("A" & lRij).Value <> ""
    If Dir("H:\Ontwikkeling" & Range("A" & lRij).Value & ".xls") <> "" Then
    Application.ScreenUpdating = False
    Workbooks.Open "H:\Ontwikkeling\" & Range("A" & lRij).Value & ".xls"
        Sheets("Verkoop").Unprotect "1234"
        Sheets("Totaal").Unprotect "1234"

    Sheets("Verkoop").[C4:C150].Copy Destination:=[N4:N150].PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Totaal").[A1].Copy Destination:=ThisWorkbook.Sheets(1).Range("F" & lRij).PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone
    Workbooks(Workbooks.Count).Close savechanges:=False
    lRij = lRij + 1
    Application.ScreenUpdating = True
    Else
        lRij = lRij + 1
    Application.ScreenUpdating = True
    End If
Wend
Sheets("Verkoop").Protect "1234"
Sheets("Totaal").Protect "1234"
End Sub


Cobbe
 
Hallo Cobbe,

Helaas, dit werkt niet

ik krijg een foutmelding, fout 9 subscript valt buiten bereik

geen idee wat ik hier mee moet

en wat doet de ""1234" in de code?

met vriendelijke groet,
gammelkeunited
 
Code:
Private Sub CommandButton1_Click()
Dim lRij As Long
lRij = 2

While Range("A" & lRij).Value <> ""
If Dir("H:\Ontwikkeling" & Range("A" & lRij).Value & ".xls") <> "" Then
Application.ScreenUpdating = False
Workbooks.Open "H:\Ontwikkeling\" & Range("A" & lRij).Value & ".xls"
ActiveWorkbook.sheets("verkoop").Unprotect
Sheets("Verkoop").Range("C4:C150").Copy Range("N4:N150")
ActiveWorkbook.sheets("Totaal").Unprotect
Sheets("Totaal").Range("A1").Copy Sheets(1).Range("F" & lRij)
Workbooks(Workbooks.Count).Close savechanges:=False
lRij = lRij + 1
Application.ScreenUpdating = True
Else
lRij = lRij + 1
Application.ScreenUpdating = True
End If

Wend
End Sub

Deze code moet het doen als het goed is. aangezien het de map niet opnieuw word opgeslagen hoef je hem ook niet te protecten
 
Laatst bewerkt:
Hallo mensen,

het werkt! super bedankt aan allen

ik ben alleen een nieuw probleem tegen gekomen.

in de volgende regels van de code
Sheets("Totaal").Activate
ActiveSheet.[A1].Select
Selection.Copy
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Range("F" & lRij).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

word de waarde in cel a1 van het blad "totaal" gekopieerd naar het andere blad.
soms staat er in cel a1: #N/B. dit is niet erg. echter bij een tweetal bestanden geeft hij na het kopieren niet #N/B weer maar # WAARDE. dit is niet de bedoeling.

wie weet hoe dit kan?

met vriendelijke groet,
gammelkeunited
 
Kijk eens na of de opgezochte getallen als tekst zijn weergegeven.

Mvg

Rudi
 
Hallo Rudi,

ik heb het nagekeken, maar de cellen hebben de eigenschap standaard. ook als ik de celeigenschappen instel op getal, treed er hetzelfde probleem op.

met vriendelijke groet,

gammelkeunited
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan