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

Opgelost Excel VBA werkt en werkt niet

Dit topic is als opgelost gemarkeerd
B

bartvt78

Gebruiker
Lid geworden
16 mrt 2017
Berichten
255
Besturingssysteem
Mac OS en Windows Parallels
Office versie
Office 365
Goedemiddag collega forumleden. Ik zit momenteel met een probleem. Ik heb met behulp van ChatGPT volgende VBA geschreven. Als ik deze test, met stap voor stap functie in VBA werkt deze perfect. Maar als ik deze wil laten lopen met een drukknop in excel, werkt deze niet. Verder wil ik ook op het laatste beide sheets beveiligen, maar op WsTarget moet er in kolom AI een hyperlink worden toegevoegd (manueel, nadat het script beëindigd is) Als ik de sheet gewoon beveilig, kan er nadien geen hyperlink meer ingevoegd worden. En voor dit laatste stukje laat ChatGPT me dus in de steek. Ik hoop dat onderstaande code genoeg is, daar de hele file nogal groot is. Hartelijk dank voor mee te denken.
Mvg,
Bart

Code: 
Sub Buy_Copy()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim pasteCell As Range

    Set wsSource = ActiveSheet
    Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")

    wsSource.Unprotect Password:="Test"
    
    'Copy source cells
    wsSource.Range("B8").Copy

    'Go to Trades Advanced and use the selected cell as destination
    wsTarget.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Selection.Offset(0, 1).Select

    'Copy source cells
     wsSource.Activate
    wsSource.Range("C8").Copy

    'Go to Trades Advanced and use the selected cell as destination
    wsTarget.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Selection.Offset(0, 6).Select
    
    'Copy source cells
    wsSource.Activate
    wsSource.Range("D8").Copy
    'Go to Trades Advanced and use the selected cell as destination
    wsTarget.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Selection.Offset(0, 1).Select
    'Copy source cells
    wsSource.Activate
    wsSource.Range("E8").Copy
    'Go to Trades Advanced and use the selected cell as destination
    wsTarget.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Selection.Offset(0, 2).Select
    'Copy source cells
    wsSource.Activate
    wsSource.Range("I8").Copy
    'Go to Trades Advanced and use the selected cell as destination
    wsTarget.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.CutCopyMode = False


        
    'Select target sheet at the end
    wsTarget.Activate

End Sub
 
Claude ai kwam met deze code.

Code: 
Sub Buy_Copy()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim pasteCell As Range

    Set wsSource = ThisWorkbook.Worksheets("NaamBronSheet")   'pas aan
    Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")

    'Beide sheets vrijgeven
    wsSource.Unprotect Password:="Test"
    wsTarget.Unprotect Password:="Test"

    'Startcel = actieve cel op Trades Advanced
    wsTarget.Activate
    Set pasteCell = ActiveCell

    'Waarden overzetten
    pasteCell.Value = wsSource.Range("B8").Value
    pasteCell.Offset(0, 1).Value = wsSource.Range("C8").Value
    pasteCell.Offset(0, 7).Value = wsSource.Range("D8").Value
    pasteCell.Offset(0, 8).Value = wsSource.Range("E8").Value
    pasteCell.Offset(0, 10).Value = wsSource.Range("I8").Value

    'Kolom AI ontgrendelen zodat daar manueel een hyperlink kan worden ingevoegd
    wsTarget.Columns("AI").Locked = False

    'Beide sheets weer beveiligen
    wsSource.Protect Password:="Test"

    wsTarget.Protect Password:="Test", _
        AllowInsertingHyperlinks:=True

End Sub
 
Hey Peter, Bedankt voor bovenstaande code, echter loopt VBA vast op de regel wsTarget.Columns("AI").Locked = False. Dit had ChatGPT me ook al voorgesteld, zonder resultaat. En ChatGPT had me ook volgende lijn voorgesteld, maar daar loopt die ook op vast.
AllowInsertingHyperlinks:=True
 
Wat is de foutmelding?
 
Fout 1004 tijdens runtime:
Eigenschap Locked van klasse Range kan niet worden ingesteld.

De issue van het niet werken van de knoppen is opgelost. Een keer opslaan, sluiten en terug openen en de knoppen werkten terug. Maar de code is dus nog niet compleet. Ik gebruik de NL versie van Office 365
 
Code volgens AI. Zelf bestuderen.
PHP: 
Sub Buy_Copy()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim startCell As Range

    Application.ScreenUpdating = False

    Set wsSource = ActiveSheet
    Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")

    ' Sheets van het slot
    wsSource.Unprotect Password:="Test"
    wsTarget.Unprotect Password:="Test"
    
    ' Startpunt bepalen (de geselecteerd cel in Trades Advanced)
    Set startCell = ActiveCell
    
    ' Waarden direct overzetten (omzeilt het drukknop-probleem)
    startCell.Value = wsSource.Range("B8").Value
    startCell.Offset(0, 1).Value = wsSource.Range("C8").Value
    startCell.Offset(0, 7).Value = wsSource.Range("D8").Value
    startCell.Offset(0, 8).Value = wsSource.Range("E8").Value
    startCell.Offset(0, 10).Value = wsSource.Range("I8").Value

    ' === NL OFFICE 365 VEILIGE METHODE VOOR RECHTEN ===
    
    ' 1. Cellen standaard op slot, MAAR kolom AI (kolom 35) expliciet ontgrendelen
    wsTarget.Cells.Locked = True
    wsTarget.Columns("AI").Locked = False

    ' 2. Bronblad beveiligen
    wsSource.Protect Password:="Test", UserInterfaceOnly:=True
                    
    ' 3. Doelblad beveiligen: we gebruiken DrawingObjects en Scenarios op False
    ' en UserInterfaceOnly op True. Omdat kolom AI hierboven is ontgrendeld (Locked = False),
    ' staat Excel 365 NL in een ontgrendelde kolom ALTIJD toe om via het menu
    ' of de sneltoets (CRTL+K) een hyperlink in te voegen!
    wsTarget.Protect Password:="Test", _
                     DrawingObjects:=False, _
                     Scenarios:=False, _
                     UserInterfaceOnly:=True

    ' Doelblad activeren
    wsTarget.Activate
    
    Application.ScreenUpdating = True
    
    MsgBox "Gegevens gekopieerd! Kolom AI is vrijgegeven voor hyperlinks.", vbInformation
End Sub
 
Hey Senso, ik ga het vanavond implementeren. Ik houd je op de hoogte.
 
Hey Senso, ik heb jou code bekeken, en deze werkt tot aan lijn wsTarget.Columns("AI").Locked = False.
Hier loopt het script vast. Ik heb ondertussen het probleem kunnen identificeren. Ik ben aan het werken met excel 365 in mijn Macbook. Als ik in Parallels ga, en deze code in een windows omgeving laat lopen werkt dit wel. Maar nu is de vraag dus hoe ik dit werkend in MacOS kan laten werken.
 
Volgens AI de aangepaste code die zowel op macOS als Windows stabiel draait.
Zelf bestuderen.
PHP: 
Sub Buy_Copy_Mac()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim startCell As Range
   
    Application.ScreenUpdating = False
   
    Set wsSource = ActiveSheet
    Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")
   
    ' Sheets van het slot
    wsSource.Unprotect Password:="Test"
    wsTarget.Unprotect Password:="Test"
   
    ' MACOS FIX: Activeer eerst expliciet het doelblad om de juiste ActiveCell op te halen
    wsTarget.Activate
    Set startCell = Selection.Cells(1, 1) ' Pakt de eerste cel van de huidige selectie op wsTarget
   
    ' Waarden direct overzetten (omzeilt het drukknop-probleem op Mac en Windows)
    startCell.Value = wsSource.Range("B8").Value
    startCell.Offset(0, 1).Value = wsSource.Range("C8").Value
    startCell.Offset(0, 7).Value = wsSource.Range("D8").Value
    startCell.Offset(0, 8).Value = wsSource.Range("E8").Value
    startCell.Offset(0, 10).Value = wsSource.Range("I8").Value
   
    ' === NL OFFICE 365 VEILIGE METHODE VOOR RECHTEN ===
    ' 1. Cellen standaard op slot, MAAR kolom AI (kolom 35) expliciet ontgrendelen
    wsTarget.Cells.Locked = True
    wsTarget.Columns("AI").Locked = False
   
    ' 2. Bronblad beveiligen
    wsSource.Protect Password:="Test", UserInterfaceOnly:=True
   
    ' 3. Doelblad beveiligen
    wsTarget.Protect Password:="Test", _
        DrawingObjects:=False, _
        Scenarios:=False, _
        UserInterfaceOnly:=True
       
    Application.ScreenUpdating = True
   
    MsgBox "Gegevens gekopieerd! Kolom AI is vrijgegeven voor hyperlinks.", vbInformation
End Sub
 
Ik heb geen Mac dus kan hem niet testen.

Code: 
Sub Buy_Copy_Mac_Short()
    Dim wsSource As Worksheet: Set wsSource = ActiveSheet
    Dim wsTarget As Worksheet: Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")

    wsSource.Unprotect "Test"
    wsTarget.Unprotect "Test"

    wsTarget.Activate
    
    With ActiveCell
        .Value = wsSource.Range("B8").Value
        .Offset(0, 1).Value = wsSource.Range("C8").Value
        .Offset(0, 7).Value = wsSource.Range("D8").Value
        .Offset(0, 8).Value = wsSource.Range("E8").Value
        .Offset(0, 10).Value = wsSource.Range("I8").Value
    End With
    
    wsTarget.Cells.Locked = True
    wsTarget.Columns("AI").Locked = False
    
    wsSource.Protect "Test"
    wsTarget.Protect "Test", AllowInsertingHyperlinks:=True, AllowFormattingCells:=True
    
    MsgBox "Gekopieerd! Kolom AI is vrij.", vbInformation
End Sub
 
Dank u Senso en Jverkerk, maar in MacOS loopt het steeds fout op die "Locked=False". En volgens mijn AI zou het moeten werken, maar dat is het dus niet. En aangezien AI zegt dat het werkt, geeft het ook geen andere oplossingen. Bij mij toch alleszins niet. Dan zal het maar moeten draaien in de windows omgeving tot er een magic oplossing komt. :)
 
Probeer eens,
Code: 
wsTarget.columns("AI:AI").locked = false
op de Mac
 
Hey HSV, ook dit geeft een fout, nl: "Eigenschap Locked van klasse Range kan niet worden ingesteld."
 
Heb je samengoevoegde cellen met de naastliggende kolom(men)?
 
Neen, dat is niet het geval. Allemaal enkele cellen.
 
Je zou het haast denken, de foutmelding krijg ik ook in een test.
 
Deze misschien voor de Mac?
Verbeterde mac proof versie

Code: 
Sub Buy_Copy_Mac_Final()
    Dim wsSource As Worksheet: Set wsSource = ActiveSheet
    Dim wsTarget As Worksheet: Set wsTarget = ThisWorkbook.Worksheets("Trades Advanced")
    Dim targetCell As Range
    
    Set targetCell = Application.ActiveCell
    
    wsSource.Unprotect "Test"
    wsTarget.Unprotect "Test"
    
    With targetCell
        .Value = wsSource.Range("B8").Value
        .Offset(0, 1).Value = wsSource.Range("C8").Value
        .Offset(0, 7).Value = wsSource.Range("D8").Value
        .Offset(0, 8).Value = wsSource.Range("E8").Value
        .Offset(0, 10).Value = wsSource.Range("I8").Value
    End With
    
    wsTarget.Columns("A:AH").Locked = True
    wsTarget.Columns("AI").Locked = False
    wsTarget.Columns("AJ:XFD").Locked = True
    
    wsSource.Protect "Test"
    wsTarget.Protect "Test", AllowInsertingHyperlinks:=True, AllowFormattingCells:=True
    
    wsTarget.Activate
    MsgBox "Gekopieerd! Kolom AI is vrij voor hyperlinks.", vbInformation
End Sub
 
Als het steeds strompeld over:
Code: 
wsTarget.Columns("AI").Locked = False

dan.....
Code: 
wsTarget.Cells.Locked = False
wsTarget.Columns("A:AH").Locked = True
wsTarget.Columns("AJ:XFD").Locked = True
 
Volgens AI:
U moet de code dwingen om het blad tijdelijk te ontgrendelen vóór de .Locked-regel, en daarna weer te beveiligen. Daarnaast gebruiken we .MergeArea om te voorkomen dat samengevoegde cellen de boel blokkeren.
Vervang het deel van de code dat vastloopt door deze structuur:

PHP: 
Sub MacVeiligeVergrendeling()
    Dim TargetRange As Range
    Set TargetRange = Range("A1:B10") ' Pas dit bereik aan naar uw situatie
   
    ' 1. Haal de bladbeveiliging eraf (vul eventueel uw wachtwoord in)
    ActiveSheet.Unprotect Password:=""
   
    ' 2. Voer de vergrendeling uit
    On Error Resume Next ' Extra vangnet voor Mac-specifieke range-fouten
    TargetRange.Locked = False
    On Error GoTo 0 ' Zet foutopsporing weer aan
   
    ' 3. Zet de bladbeveiliging direct weer terug
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
End Sub

Waar u extra op moet letten bij macOS:
  • Wachtwoord: Gebruikt u een wachtwoord om het blad te beveiligen? Vul deze dan in tussen de aanhalingstekens bij Password:="UwWachtwoord" (zowel bij .Unprotect als .Protect).

  • Geselecteerde cellen: Vermijd constructies met Selection.Locked = False. Definieer liever het exacte bereik (zoals Range("A1").Locked = False), dat werkt op een Mac stabieler.
 
Ik bekijk bovenstaande mogelijke oplossingen morgen. Mijn ogen een beetje rust gunnen. Ik kom morgen met feedback voor alle voorstellen.
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan