Ik probeer nog een bladbeveiliging in te voeren (zonder wachtwoord) maar krijg dat niet voor elkaar.
Het "regel invoegscript" en het "regel verwijder script" zijn op een of andere manier aan elkaar gelinkt? Ze werken in elk geval niet als in in beide scripts een regel toevoeg om de beveiliging op te heffen en vervolgens weer aan te zetten.
Cow18, kun je me nog van informatie voorzien hoe dit te doen?
[JS][XML][SQL]Const iKol = 745 'aantal kolommen vanaf C tot ABQ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target '-> cel waarin gedubbelklikt wordt
If Intersect(Target, Range("B8:B500")) Is Nothing Then Exit Sub 'niet dubbelklikken in die B-range = einde verhaal
If .MergeCells Or .Offset(, -1).MergeCells Then ' kijken of die B-cel een samengevoegde cel is, zoniet einde verhaal
.Offset(1).Resize(1, iKol).Insert Shift:=xlDown 'onder die samengevoegde cel, in een rij iKol cellen breed invoegen
With .Resize(Target.Rows.Count + 1) 'die samengevoegd cel + nieuwe B-cel
.MergeCells = True 'samenvoegen
'.Borders(xlEdgeBottom).Weight = xlMedium 'onderkant medium dikke streep
End With
With .Offset(, -1).Cells(1).MergeArea 'de cel links ernaast in de A-kolom
If .MergeCells Then 'is een samengevoegde cel
.Offset(1).Resize(1).Insert Shift:=xlDown 'onder die samengevoegde cel, 1 cel invoegen
Application.DisplayAlerts = False
With .Resize(.Rows.Count + 1) 'die samengevoegd cel + nieuwe A-cel
.MergeCells = True 'samenvoegen
.Borders(xlEdgeBottom).Weight = xlMedium 'onderkant medium dikke streep
.Borders(xlEdgeTop).Weight = xlMedium 'bovenkant nieuwe rij, dikke streep
.Borders(xlEdgeRight).Weight = xlMedium 'rechterkant nieuwe rij, medium streep
.Borders(xlEdgeLeft).Weight = xlMedium 'rechterkant nieuwe rij, medium streep
.Borders(xlEdgeBottom).Weight = xlMedium 'onderkantkant nieuwe rij, medium streep
.Borders(xlInsideHorizontal).Weight = xlThin 'rechterkant nieuwe rij, medium streep
End With
Application.DisplayAlerts = True
Else
MsgBox "foutje met niet-samengevoegde A-cel " & .Address, vbCritical
End If
End With
With .Offset(, 1).Cells(Target.Rows.Count + 1, 1).Resize(1, iKol) 'nieuw toegevoegde cellen vanaf C-kolom en dik 700 kolommen breed
.Offset(-1).Copy .Cells(1) 'kopieer laatste rij naar nieuwe rij
On Error Resume Next 'doorgaan bij foutmelding
.SpecialCells(xlConstants).ClearContents 'alle cellen met vaste inhoud (geen formules) leegmaken
On Error GoTo 0
End With
With .Cells(1).MergeArea.Resize(, iKol)
.Borders(xlEdgeTop).Weight = xlMedium 'bovenkant nieuwe rij, fijne streep
.Borders(xlEdgeRight).Weight = xlMedium 'rechterkant nieuwe rij, medium streep
.Borders(xlEdgeLeft).Weight = xlMedium 'rechterkant nieuwe rij, medium streep
.Borders(xlEdgeBottom).Weight = xlMedium 'onderkantkant nieuwe rij, medium streep
.Borders(xlInsideHorizontal).Weight = xlThin 'rechterkant nieuwe rij, medium streep
End With
.Interior.Color = 8703650
Application.Goto .Offset(.Cells(1).MergeArea.Rows.Count - 1, 1).Cells(1), 0 'ga in de nieuw ingevoegde C-cel staan
End If
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If .Rows.Count = 1 And .Columns.Count = Columns.Count And .Row > 8 Then 'je hebt een ganse rij geselecteerd
Set c1 = .Cells(1).MergeArea.Cells(1) '1e cel van de samengevoegde cellen van die rij in de A-kolom
Set cma = .Cells(1, 2).MergeArea 'samengevoegde cellen in de B-kolom
Set c2 = .Cells(1, 2).MergeArea.Cells(1) 'idem voor de B-kolom
If c1.Address <> .Cells(1).Address And c2.Address <> .Cells(1, 2).Address Then 'A en B cel zijn samengevoegde cellen, maar niet de 1e van die samengevoegde cel
If cma.Cells(cma.Rows.Count, 1).Address = .Cells(1, 2).Address Then 'B-cel is de laatste van die samengevoegde cel
If MsgBox("ben je zeker dat rij " & Target.Row & " weg mag ?", vbYesNo) = vbYes Then 'bevestiging vragen
.Cells(1).Resize(, iKol + 1).Delete xlShiftUp 'zoveel cellen weg
c1.Cells(1).MergeArea.Resize(, iKol + 1).Borders(xlEdgeBottom).Weight = xlMedium 'onderkantkant nieuwe rij, medium streep
Application.Goto .Cells(0, 3), 0 'naar de C-kolom gaan
End If
End If
End If
End If
End With
End Sub[/SQL][/XML][/JS]
