Hallo
Ik wens over te stappen van Excel naar Calc maar in mijn werkbladen in Excel had ik een VBA-script (niet zelf gemaakt) waardoor er automatisch een rij werd bijgemaakt onder de rij die gebruikt/bewerkt werd indien ik in kolom 2 ofwel "i" ofwel "u" tikte.(Bedoeling : steeds twee blanco rijen tussen een laatste rij met data/cijfers en de totalen).
Dit werkt niet meer in Calc.
Het script uit Excel is :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rij As Integer, Kolom As Integer
Dim Waarde As String
Rij = Target.Row
Kolom = Target.Column
If Kolom = 2 Then
Application.ScreenUpdating = False
Waarde = UCase(Trim(Target.Value))
If Waarde = "I" Or Waarde = "U" Then
Application.CutCopyMode = False
Rows(Rij & ":" & Rij).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(Rij + 1 & ":" & Rij + 1).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.ClearContents
Range("C" & Rij).Select
Application.CutCopyMode = True
End If
Application.ScreenUpdating = True
End If
Op http://www.business-spreadsheets.com/vba2oo.asp vond ik een convertor en die gaf als CalcBasicCode :
Private Sub Worksheet_Change(ByVal Target As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1))
Dim Rij As Integer, Kolom As Integer
Dim Waarde As String
Rij = Target.Row
Kolom = Target.Column
If Kolom = 2 Then
ThisComponent.LockControllers
Waarde = UCase(Trim(Target.Value))
If Waarde = "I" Or Waarde = "U" Then
Application.CutCopyMode = False
Rows(Rij & ":" & Rij).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(Rij + 1 & ":" & Rij + 1).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.clearContents(com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.DATETIME)
Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet
ThisComponent.CurrentController.select(oSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(("C" & Rij)))
Application.CutCopyMode = True
End If
ThisComponent.UnlockControllers
End If
Kan iemand die er iets van afweet dit uittesten ? En, indien het werkt, hoe/waar moet deze dan geplaatst worden in Calc.
Thx
Luc
Ik wens over te stappen van Excel naar Calc maar in mijn werkbladen in Excel had ik een VBA-script (niet zelf gemaakt) waardoor er automatisch een rij werd bijgemaakt onder de rij die gebruikt/bewerkt werd indien ik in kolom 2 ofwel "i" ofwel "u" tikte.(Bedoeling : steeds twee blanco rijen tussen een laatste rij met data/cijfers en de totalen).
Dit werkt niet meer in Calc.
Het script uit Excel is :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rij As Integer, Kolom As Integer
Dim Waarde As String
Rij = Target.Row
Kolom = Target.Column
If Kolom = 2 Then
Application.ScreenUpdating = False
Waarde = UCase(Trim(Target.Value))
If Waarde = "I" Or Waarde = "U" Then
Application.CutCopyMode = False
Rows(Rij & ":" & Rij).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(Rij + 1 & ":" & Rij + 1).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.ClearContents
Range("C" & Rij).Select
Application.CutCopyMode = True
End If
Application.ScreenUpdating = True
End If
Op http://www.business-spreadsheets.com/vba2oo.asp vond ik een convertor en die gaf als CalcBasicCode :
Private Sub Worksheet_Change(ByVal Target As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1))
Dim Rij As Integer, Kolom As Integer
Dim Waarde As String
Rij = Target.Row
Kolom = Target.Column
If Kolom = 2 Then
ThisComponent.LockControllers
Waarde = UCase(Trim(Target.Value))
If Waarde = "I" Or Waarde = "U" Then
Application.CutCopyMode = False
Rows(Rij & ":" & Rij).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(Rij + 1 & ":" & Rij + 1).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.clearContents(com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.DATETIME)
Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet
ThisComponent.CurrentController.select(oSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(("C" & Rij)))
Application.CutCopyMode = True
End If
ThisComponent.UnlockControllers
End If
Kan iemand die er iets van afweet dit uittesten ? En, indien het werkt, hoe/waar moet deze dan geplaatst worden in Calc.
Thx
Luc