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

Rijen invoegen in beveiligd werkblad

Status
Niet open voor verdere reacties.

Roughneck

Gebruiker
Lid geworden
29 mei 2007
Berichten
83
Cobbe (mega Senior) kwam met deze code op de proppen. Dit werkt goed, maar ik wil het verwerken in een inputbox, waarin men het aantal regels opgeeft dat men nodig denkt te hebben in het werkblad, in het echt kunnen dat er momenteel tot plusminus 200 worden. De opmaak van de cellen (let wel: de opmaak is beschermd, de inhoud niet) moet behouden blijven.


Code:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect
Rows(ActiveCell.Row).EntireRow.Insert Shift:=xlShiftDown
ActiveSheet.Protect
End Sub

Vlak voor het opslaan van het werkblad, worden de eventuele overgebleven lege regels verwijderd. Dit is al voor elkaar. Ook dankzij Cobbe, en een beetje gezond verstand.

Het bestandje:
 

Bijlagen

  • invoegen.xls
    36 KB · Weergaven: 105
Roughneck,

Kijk eens of dit aan je wens vodoet.
Code:
Private Sub CommandButton2_Click()
Regel = InputBox("Hoeveelregels?")
ActiveSheet.Unprotect
For i = 1 To Regel
  Rows(ActiveCell.Row).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub

Het kan ook zo
Code:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect
For i = 1 To InputBox("Hoeveelregels?")
  Rows(ActiveCell.Row).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub
 
Laatst bewerkt:
Ik zit niet thuis maar ik zal het zeker gaan proberen. Maar neemt deze procedure ook de celeigenschappen van de reeds bestaande regels over?
 
Ik zit niet thuis maar ik zal het zeker gaan proberen. Maar neemt deze procedure ook de celeigenschappen van de reeds bestaande regels over?

Als de macro die je geplaatst heb het doet moet deze het ook doen.
Ik heb er enkel maar wat code bij gezet.
 
Ja, dit gaat goed, hij behoud inderdaad alle celeigenschappen, ook nog in een beveiligd werkblad. Echter, de macro word ook uitgevoerd wanneer de actieve cel zich onder de lijst bevind, en dan voegt ie alleen maar lege witte regels toe. Hij zou bij het starten van de macro de actieve cel eerst moeten verplaatsen naar een plekje binnen de lijst, laten we zeggen de eerste hele lege regel en dan verder gaan met invoegen. Dat van die hele lege regel is wel belangrijk, en ik zal dat uitleggen.

Het kan voorkomen dat iemand bezig is met het vullen van de lijst, waarbij ie in cel A5 niets heeft staan, in cel B5 wél iets, en in cel C5 weer niets. En dan tot de conclusie komt:" hee, er moeten wat regels bij!" de actieve cel moet dan naar rij 6 gaan, en vanaf daar gaan invoegen. Ik hoop dat dat duidelijk is.



Voor het gemak heb ik weer een voorbeeld bijgevoegd, waarbij bovenstaande macro onder een knop is gezet.


ik vond voor het bepalen van de eerste lege regel in een lijst, deze code, maar lijkt me wat omslagtig. Ik kan m zo bewerken dat het werkt voor mijn bestandje, maar dat moet toch eenvoudiger kunnen?


Code:
Application.ScreenUpdating = False
    Sheets("VOORBLAD").Select
    Range("A1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtArtiest
    Range("B1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtAlbum
    Range("c1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtProducer
    Range("d1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtLabel
    Range("e1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtReleased
    Range("f1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    ActiveCell = txtGenre
    Range("g1").Select
    ActiveCell.Offset(0, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 0).Select
    Loop
    
    
End Sub
 

Bijlagen

  • invoegen.rar
    12,1 KB · Weergaven: 43
Laatst bewerkt:
Roughneck,

Kijk of hij het nu wel naar je zin doet.
Hij kijkt in kolom A voor de laatste regel, moet hij in een andere kolom kijken moet je dat even aanpassen.
Code:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect
For i = 1 To InputBox("Hoeveelregels?")
  Range("A65536").End(xlUp).Offset(1, 0).Select
  Rows(ActiveCell.Row).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub.
 
Je kan wellicht beter op Kolom C checken en dan op de voorlaatste regel beginnen tussen te voegen:

Code:
Private Sub Invoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
Rij = ActiveSheet.Range("C65500").End(xlUp).Row - 1
For i = 1 To Regel
  Rows(Rij).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub

Dan voeg je zeker geen lijnen toe tussen de ingegeven items.

Succes, Cobbe
 
Dank je Cobbe, ik ga m proberen. Je hoort het zo.

Edit na testen:

Supercobbe!!!!!! Het werkt perfect. Maakt ook niet uit waar je op dat moment staat in het werkblad. Formules worden meteen aangepast(SOM)

Deze proc gaat zeker gebruikt worden.
 
Laatst bewerkt:
Roughneck,

De code van Cobbe is inderdaad beter omdat hij vanaf de onderkant net boven de optelsom werkt.
Ik ben tenslotte niet voor niets een Amateur, en had het ook voorelkaar alleen iets anders.

Nu rest je alleen nog de vraag als opgelost te zetten. :thumb:
 
Heren,

bij de laatste set code krijg ik een foutmelding als ik de inputbox annuleer.

Fout 13 tijdens uitvoering, typen komen niet met elkaar overeen.

Hoe voorkom ik deze melding?

Had m zelf al gevonden. Moest een On error ingebouwd. Heb dit als volgt gedaan. Werkt goed, wat vinden jullie ervan?


Code:
Private Sub Invoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
On Error GoTo Errortrap
Rij = ActiveSheet.Range("F65500").End(xlUp).Row - 1
For g = 1 To Regel
  Rows(Rij).EntireRow.Insert Shift:=xlShiftDown
Next g
Errortrap:
ActiveSheet.Protect
End Sub
 
Laatst bewerkt:
Een mogelijkheid:

Code:
Private Sub Invoegen_Click()
[COLOR="red"][B]On Error GoTo fout[/B][/COLOR]
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
Rij = ActiveSheet.Range("C65500").End(xlUp).Row - 1
For i = 1 To Regel
  Rows(Rij).EntireRow.Insert Shift:=xlShiftDown
Next i
[COLOR="red"][B]fout:[/B][/COLOR]ActiveSheet.Protect
End Sub

Succes, Cobbe
 
Klein foutje met invoegen van regels

Ik heb een kleinigheidje ontdekt in de macro Invoegen van Regels. Ik heb voor de duidelijkheid de laatste versie van het bestand bijgevoegd.

Als je het aansluitnummer intikt (15 cijfers) in kolom C en je trekt die door tot en met de laatste regel van het overzicht. Als je vervolgens denkt, verrek, ik kom regels tekort, en je wilt ze gaan invoegen, dan doe je dat, maar dan heeft ie het formuletje in kolom A niet meeingevoegd. Ik hoop dat dit verhaaltje duidelijk is, anders wordt het wel duidelijk wanneer je het bestandje gaat invullen. Zoniet laat het dan nog even weten.

NotaBene De beveiliging van het werkblad is zonder wachtwoord.

Het maakt niet uit of de beveiliging erop is of eraf. Hij voegt echt lege regels toe, hij zou misschien een lege regel (met formule) als voorbeeld moeten nemen voor het invoegen, dus een soort copy paste opdracht? Misschien de laatste regel volledig beschermen, zodat deze altijd leeg blijft en deze als voorbeeld nemen? Ik roep maar wat onzinnigs.
 

Bijlagen

  • Leeg Borderel v2.3.rar
    42,2 KB · Weergaven: 79
Laatst bewerkt:
Gebruik deze eens voor het toevoegen van rijen:

Code:
Private Sub Invoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
On Error GoTo Fout
For i = 1 To Regel
  rij = ActiveSheet.Range("F65500").End(xlUp).Row - 1
  Rows(rij).EntireRow.Copy
  Rows(rij).EntireRow.Insert Shift:=xlShiftDown
  Rows(rij + 1).PasteSpecial Paste:=xlFormulas
Next i
Fout:
ActiveSheet.Protect
End Sub

Succes, Cobbe
 
Wouw, Cobbe, zo snel. Het werkt goed. Ik ga m testen, daarvoor moet ik weer even transformeren in een halve idioot, en ik kan je vertellen, dat is vermoeiend hoor:p

Wil niet zeggen dat er alleen maar halve idioten werken bij mij, maar met excel weten ze een bestandje zo te verknoeien hoor.

Je hoort nog van me.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan