• 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.

Uitvoeren vba die beveiligd is

Status
Niet open voor verdere reacties.
L

linkav

Gebruiker
Lid geworden
13 jun 2007
Berichten
465
Ik heb een sheet met een aantal knoppen (met onder iedere knop vba code).

De vba code heb ik beveiligd.

klik ik bij mij op een knop wordt de vba code uitgevoerd, klikt de gebruik (op zijn pc) op een knop wordt de vba-code niet uitgevoerd.
Haal ik de beveiliging weg werkt alles perfect bij de gebruiker.

Wat kan de reden zijn van dit probleem en hoe los ik dit op.
 
Beste Cobbe,

bedankt voor je reactie, maar volgens mij gaat dit over tabbladen die beveiligd zijn. Ik heb de vba-code beveiligd door eerst met alt+F11 naar de code te gaan en dan in het menu kiezen voor Extra/Eigenschappen van het VBA-project en dan op het tabblad 'Beveiliging' een wachtwoord in te geven.

Of heb ik het toch fout?
 
Dat heeft geen invloed op de werking van macro's.
Maar als je de werkbladen beveiligd loopt het mis.
 
Staat de macro-beveiling van Excel zelf wel goed ingesteld?
 
Octafish,

Waar kan ik dat terugvinden? En deze instellingen zouden dan anders zijn op mijn pc tov de pc van de gebruiker.
 
Kun je de gebruikte code eens posten?
Wellicht zit daar toch iets tussen dat dit veroorzaakt.
 
Cobbe,

Hierbij een stukje code. Er is een knop 'Lees CSV-bestanden' en het is de bedoeling dat 1 tot 5 CSV-bestanden ingelezen worden. Het aantal is afhankelijk van het aantal bestandsnamen die vermeld staan op het tabblad 'Parameters'.

Code: 
Sub Knp_Import_xlsx_Briljant()
On Error GoTo err_Knp_Import_xlsx_Briljant
    Dim tmpSysBriljExpPath      As String
    Dim tmpSysBriljExpFile1     As String
    Dim tmpSysBriljExpFile2     As String
    Dim tmpSysBriljExpFile3     As String
    Dim tmpSysBriljExpFile4     As String
    Dim tmpSysBriljExpFile5     As String
    Dim tmpSysBriljExpExt       As String
    Dim tmpSysBriljExpFullName1 As String
    Dim tmpSysBriljExpFullName2 As String
    Dim tmpSysBriljExpFullName3 As String
    Dim tmpSysBriljExpFullName4 As String
    Dim tmpSysBriljExpFullName5 As String

    Application.ScreenUpdating = False
    
    'Verwijder tab 'Export'
    Application.DisplayAlerts = False
        On Error Resume Next
        Sheets("Export").Select
        If Err.Number = 0 Then
            ActiveWindow.SelectedSheets.Delete
        End If
        On Error GoTo err_Knp_Import_xlsx_Briljant
    Application.DisplayAlerts = True
    
    tmpSysBriljExpFile1 = ""
    tmpSysBriljExpFile2 = ""
    tmpSysBriljExpFile3 = ""
    tmpSysBriljExpFile4 = ""
    tmpSysBriljExpFile5 = ""
    tmpSysBriljExpPath = ""
    
    tmpSysBriljExpPath = Trim(Range("Parameters!sysBriljExpPath").Value)
    If Right(tmpSysBriljExpPath, 1) <> "\" Then
        tmpSysBriljExpPath = tmpSysBriljExpPath & "\"
    End If
    If Range("Parameters!sysBriljExpFile1") <> "" Then tmpSysBriljExpFile1 = Trim(Range("Parameters!sysBriljExpFile1"))
    If Range("Parameters!sysBriljExpFile2") <> "" Then tmpSysBriljExpFile2 = Trim(Range("Parameters!sysBriljExpFile2"))
    If Range("Parameters!sysBriljExpFile3") <> "" Then tmpSysBriljExpFile3 = Trim(Range("Parameters!sysBriljExpFile3"))
    If Range("Parameters!sysBriljExpFile4") <> "" Then tmpSysBriljExpFile4 = Trim(Range("Parameters!sysBriljExpFile4"))
    If Range("Parameters!sysBriljExpFile5") <> "" Then tmpSysBriljExpFile5 = Trim(Range("Parameters!sysBriljExpFile5"))
    
    tmpSysBriljExpExt = "xlsx"
    
    tmpSysBriljExpFullName1 = tmpSysBriljExpPath & tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt
    tmpSysBriljExpFullName2 = tmpSysBriljExpPath & tmpSysBriljExpFile2 & "." & tmpSysBriljExpExt
    tmpSysBriljExpFullName3 = tmpSysBriljExpPath & tmpSysBriljExpFile3 & "." & tmpSysBriljExpExt
    tmpSysBriljExpFullName4 = tmpSysBriljExpPath & tmpSysBriljExpFile4 & "." & tmpSysBriljExpExt
    tmpSysBriljExpFullName5 = tmpSysBriljExpPath & tmpSysBriljExpFile5 & "." & tmpSysBriljExpExt
    
    If tmpSysBriljExpFile1 = "" And tmpSysBriljExpFile2 = "" And tmpSysBriljExpFile3 = "" _
        And tmpSysBriljExpFile4 = "" And tmpSysBriljExpFile5 = "" Then
        Beep
        msg = "Geen bestanden ingevoerd om in te lezen ........ "
               Style = vbOKOnly + vbExclamation
               Title = "Controle invoer"
               Answer = MsgBox(msg, Style, Title, Help, 64)
        Exit Sub
    End If
        
    'Controleer of bestand1 in de map staat
    If tmpSysBriljExpFile1 <> "" Then
        blnOK = False
        tmpFileName = Dir(tmpSysBriljExpPath)
        
        Do Until tmpFileName = ""
            If tmpFileName = tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt Then
                blnOK = True
            End If
            tmpFileName = Dir
        Loop
        
        If blnOK = False Then
            Beep
            msg = "Bestand1 niet gevonden........ (" & tmpSysBriljExpFullName1 & ")"
                   Style = vbOKOnly + vbExclamation
                   Title = "Controle invoer"
                   Answer = MsgBox(msg, Style, Title, Help, 64)
            Exit Sub
        End If
    End If
    If tmpSysBriljExpFile2 <> "" Then
        'Controleer of bestand2 in de map staat
        blnOK = False
        tmpFileName = Dir(tmpSysBriljExpPath)
        
        Do Until tmpFileName = ""
            If tmpFileName = tmpSysBriljExpFile2 & "." & tmpSysBriljExpExt Then
                blnOK = True
            End If
            tmpFileName = Dir
        Loop
        
        If blnOK = False Then
            Beep
            msg = "Bestand2 niet gevonden........ (" & tmpSysBriljExpFullName2 & ")"
                   Style = vbOKOnly + vbExclamation
                   Title = "Controle invoer"
                   Answer = MsgBox(msg, Style, Title, Help, 64)
            Exit Sub
        End If
    End If
    If tmpSysBriljExpFile3 <> "" Then
        'Controleer of bestand3 in de map staat
        blnOK = False
        tmpFileName = Dir(tmpSysBriljExpPath)
        
        Do Until tmpFileName = ""
            If tmpFileName = tmpSysBriljExpFile3 & "." & tmpSysBriljExpExt Then
                blnOK = True
            End If
            tmpFileName = Dir
        Loop
        
        If blnOK = False Then
            Beep
            msg = "Bestand3 niet gevonden........ (" & tmpSysBriljExpFullName3 & ")"
                   Style = vbOKOnly + vbExclamation
                   Title = "Controle invoer"
                   Answer = MsgBox(msg, Style, Title, Help, 64)
            Exit Sub
        End If
    End If
    If tmpSysBriljExpFile4 <> "" Then
        'Controleer of bestand4 in de map staat
        blnOK = False
        tmpFileName = Dir(tmpSysBriljExpPath)
        
        Do Until tmpFileName = ""
            If tmpFileName = tmpSysBriljExpFile4 & "." & tmpSysBriljExpExt Then
                blnOK = True
            End If
            tmpFileName = Dir
        Loop
        
        If blnOK = False Then
            Beep
            msg = "Bestand4 niet gevonden........ (" & tmpSysBriljExpFullName4 & ")"
                   Style = vbOKOnly + vbExclamation
                   Title = "Controle invoer"
                   Answer = MsgBox(msg, Style, Title, Help, 64)
            Exit Sub
        End If
    End If
    If tmpSysBriljExpFile5 <> "" Then
        'Controleer of bestand5 in de map staat
        blnOK = False
        tmpFileName = Dir(tmpSysBriljExpPath)
        
        Do Until tmpFileName = ""
            If tmpFileName = tmpSysBriljExpFile5 & "." & tmpSysBriljExpExt Then
                blnOK = True
            End If
            tmpFileName = Dir
        Loop
        
        If blnOK = False Then
            Beep
            msg = "Bestand5 niet gevonden........ (" & tmpSysBriljExpFullName5 & ")"
                   Style = vbOKOnly + vbExclamation
                   Title = "Controle invoer"
                   Answer = MsgBox(msg, Style, Title, Help, 64)
            Exit Sub
        End If
    End If
    If tmpSysBriljExpFile1 <> "" Then
        'Inlezen van bestand 1
        Workbooks.OpenText Filename:=tmpSysBriljExpFullName1, DataType:=xlDelimited, Semicolon:=True, Local:=True
    
        Windows(tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt).Activate
        
        Application.DisplayAlerts = False
            Columns("A:A").Select
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
                ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
                (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1)), _
                TrailingMinusNumbers:=True
        
                Windows("ATS_Prijsberekening.xlsm").Activate
                On Error Resume Next
                    Sheets("Export").Visible = True
                    If Err.Number = 0 Then
                        Sheets("Export").Select
                        ActiveWindow.SelectedSheets.Delete
                    End If
                On Error GoTo err_Knp_Import_xlsx_Briljant
                Windows(tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt).Activate
                Sheets("Blad1").Select
                Sheets("Blad1").Move Before:=Workbooks("ATS_Prijsberekening.xlsm"). _
                    Sheets(2)
                Sheets("Blad1").Select
                Sheets("Blad1").Name = "Export"
                Range("A1").Select
        Application.DisplayAlerts = True
        Range("D1").Select
        Selection.End(xlDown).Select
        tmpRow = ActiveCell.Row
    End If
    If tmpSysBriljExpFile2 <> "" Then
        'Inlezen van bestand 2
        Workbooks.OpenText Filename:=tmpSysBriljExpFullName2, DataType:=xlDelimited, Semicolon:=True, Local:=True
        Windows(tmpSysBriljExpFile2 & "." & tmpSysBriljExpExt).Activate
        
        Application.DisplayAlerts = False
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowExp = ActiveCell.Row
            Range("A1:Y" & tmpRowExp).Select
            Selection.Copy
            
            Windows("ATS_Prijsberekening.xlsm").Activate
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowVK = ActiveCell.Row
            tmpRowVK2 = ActiveCell.Row
            Range("A" & tmpRowVK + 1 & ":Y" & tmpRowVK + tmpRowExp).Select
            ActiveSheet.Paste
        Application.DisplayAlerts = True
    End If
    If tmpSysBriljExpFile3 <> "" Then
        'Inlezen van bestand 3
        Workbooks.OpenText Filename:=tmpSysBriljExpFullName3, DataType:=xlDelimited, Semicolon:=True, Local:=True
        Windows(tmpSysBriljExpFile3 & "." & tmpSysBriljExpExt).Activate
        
        Application.DisplayAlerts = False
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowExp = ActiveCell.Row
            Range("A1:Y" & tmpRowExp).Select
            Selection.Copy
            
            Windows("ATS_Prijsberekening.xlsm").Activate
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowVK = ActiveCell.Row
            tmpRowVK3 = ActiveCell.Row
            Range("A" & tmpRowVK + 1 & ":Y" & tmpRowVK + tmpRowExp).Select
            ActiveSheet.Paste
        Application.DisplayAlerts = True
    End If
    If tmpSysBriljExpFile4 <> "" Then
        'Inlezen van bestand 4
        Workbooks.OpenText Filename:=tmpSysBriljExpFullName4, DataType:=xlDelimited, Semicolon:=True, Local:=True
        Windows(tmpSysBriljExpFile4 & "." & tmpSysBriljExpExt).Activate
        
        Application.DisplayAlerts = False
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowExp = ActiveCell.Row
            Range("A1:Y" & tmpRowExp).Select
            Selection.Copy
            
            Windows("ATS_Prijsberekening.xlsm").Activate
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowVK = ActiveCell.Row
            tmpRowVK4 = ActiveCell.Row
            Range("A" & tmpRowVK + 1 & ":Y" & tmpRowVK + tmpRowExp).Select
            ActiveSheet.Paste
        Application.DisplayAlerts = True
    End If
    If tmpSysBriljExpFile5 <> "" Then
        'Inlezen van bestand 5
        Workbooks.OpenText Filename:=tmpSysBriljExpFullName5, DataType:=xlDelimited, Semicolon:=True, Local:=True
        Windows(tmpSysBriljExpFile5 & "." & tmpSysBriljExpExt).Activate
        
        Application.DisplayAlerts = False
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowExp = ActiveCell.Row
            Range("A1:Y" & tmpRowExp).Select
            Selection.Copy
            
            Windows("ATS_Prijsberekening.xlsm").Activate
            Range("D1").Select
            Selection.End(xlDown).Select
            tmpRowVK = ActiveCell.Row
            tmpRowVK5 = ActiveCell.Row
            Range("A" & tmpRowVK + 1 & ":Y" & tmpRowVK + tmpRowExp).Select
            ActiveSheet.Paste
        Application.DisplayAlerts = True
    End If
    
    Range("A" & tmpRowVK + tmpRowExp).Select
    Range("A" & tmpRowVK + tmpRowExp + 1).Value = "@@@EINDE-EXPORT@@@"
    Range("A1").Select
    
    If tmpSysBriljExpFile2 <> "" Then
        Range("A" & tmpRowVK2 + 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
    End If
    If tmpSysBriljExpFile3 <> "" Then
        Range("A" & tmpRowVK3 + 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
    End If
    If tmpSysBriljExpFile4 <> "" Then
        Range("A" & tmpRowVK4 + 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
    End If
    If tmpSysBriljExpFile5 <> "" Then
        Range("A" & tmpRowVK5 + 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
    End If

    Columns("R:S").Select
    ActiveWindow.SmallScroll ToRight:=6
    Columns("R:T").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    
    If fnctPathExist(tmpSysBriljExpPath & "done") = False Then
        MkDir (tmpSysBriljExpPath & "done")
    End If
    
    Windows(tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt).Activate
    ActiveWorkbook.Close (False)
    Name tmpSysBriljExpPath & tmpSysBriljExpFile1 & "." & tmpSysBriljExpExt As tmpSysBriljExpPath & "done\" & tmpSysBriljExpFile1 & "_" & Format(Year(Date), "00") & Format(Month(Date), "00") & Format(Day(Date), "00") & "_" & Format(Hour(Time()), "00") & Format(Minute(Time()), "00") & Format(Second(Time()), "00") & "." & tmpSysBriljExpExt
    If tmpSysBriljExpFile2 <> "" Then
        Windows(tmpSysBriljExpFile2 & "." & tmpSysBriljExpExt).Activate
        ActiveWorkbook.Close (False)
        Name tmpSysBriljExpPath & tmpSysBriljExpFile2 & "." & tmpSysBriljExpExt As tmpSysBriljExpPath & "done\" & tmpSysBriljExpFile2 & "_" & Format(Year(Date), "00") & Format(Month(Date), "00") & Format(Day(Date), "00") & "_" & Format(Hour(Time()), "00") & Format(Minute(Time()), "00") & Format(Second(Time()), "00") & "." & tmpSysBriljExpExt
    End If
    If tmpSysBriljExpFile3 <> "" Then
        Windows(tmpSysBriljExpFile3 & "." & tmpSysBriljExpExt).Activate
        ActiveWorkbook.Close (False)
        Name tmpSysBriljExpPath & tmpSysBriljExpFile3 & "." & tmpSysBriljExpExt As tmpSysBriljExpPath & "done\" & tmpSysBriljExpFile3 & "_" & Format(Year(Date), "00") & Format(Month(Date), "00") & Format(Day(Date), "00") & "_" & Format(Hour(Time()), "00") & Format(Minute(Time()), "00") & Format(Second(Time()), "00") & "." & tmpSysBriljExpExt
    End If
    If tmpSysBriljExpFile4 <> "" Then
        Windows(tmpSysBriljExpFile4 & "." & tmpSysBriljExpExt).Activate
        ActiveWorkbook.Close (False)
        Name tmpSysBriljExpPath & tmpSysBriljExpFile4 & "." & tmpSysBriljExpExt As tmpSysBriljExpPath & "done\" & tmpSysBriljExpFile4 & "_" & Format(Year(Date), "00") & Format(Month(Date), "00") & Format(Day(Date), "00") & "_" & Format(Hour(Time()), "00") & Format(Minute(Time()), "00") & Format(Second(Time()), "00") & "." & tmpSysBriljExpExt
    End If
    If tmpSysBriljExpFile5 <> "" Then
        Windows(tmpSysBriljExpFile5 & "." & tmpSysBriljExpExt).Activate
        ActiveWorkbook.Close (False)
        Name tmpSysBriljExpPath & tmpSysBriljExpFile5 & "." & tmpSysBriljExpExt As tmpSysBriljExpPath & "done\" & tmpSysBriljExpFile5 & "_" & Format(Year(Date), "00") & Format(Month(Date), "00") & Format(Day(Date), "00") & "_" & Format(Hour(Time()), "00") & Format(Minute(Time()), "00") & Format(Second(Time()), "00") & "." & tmpSysBriljExpExt
    End If
    
    Application.ScreenUpdating = True
    
    Range("A1").Select

    Windows("ATS_Prijsberekening.xlsm").Activate
    ActiveWorkbook.Save
    
    On Error GoTo 0
    Exit Sub
err_Knp_Import_xlsx_Briljant:
    If Err.Number = 1004 Then
        Exit Sub
    End If
    MsgBox "Fout in Knp_Import_xlsx_Briljant: (" & Err.Number & ") - " & Err.Description
    Resume Next
End Sub
 
Ben je zeker dat dit alle code is die gebruikt wordt in je bestand?
 
Cobbe,

Neen ik weet zeker dat er meer is... Ik heb 15 knoppen en achter iedere knop zit vba. Maar dit is normaal gezien de eerste knop die ze zouden moeten gebruiken en hier gaat het al niet (op mijn pc wel).
 
Zet eens een ' voor elke IF ERROR regel
Run dan eens de macro en zie waar die blijft hangen, zo kom je er wellicht achter waar het fout loopt.

Kan iets met de bestandslocatie te maken hebben op die externe PC
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan