VBA script uit Excel omzetten

Status
Niet open voor verdere reacties.

leukerdt

Gebruiker
Lid geworden
11 mei 2007
Berichten
21
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
 
VBA omzetten naar BASIC

Valt niet echt mee, maar deze macro voegt een lege rij in als in kolom 2 "i"of "u" wordt
ingevoerd:

Code:
Sub Worksheet_Change()

Dim Target as Object
Dim oCell as Object
Dim Rij As Integer, Kolom As Integer
Dim Waarde As String

oSheet = ThisComponent.CurrentController.ActiveSheet
Target = ThisComponent.CurrentSelection
  
Rij = Target.CellAddress.Row
Kolom = Target.CellAddress.Column

If Kolom = 1 Then
   Waarde = UCase(Trim(Target.String))
          If Waarde = "I" Or Waarde = "U" Then
             oSheet.getRows().insertByIndex((Rij+1),1)
             oCell = oSheet.getCellByPosition(2,Rij)
             ThisComponent.CurrentController.Select(oCell)
          End If
End If

End sub

Het probleem is echter dat je dit niet aan een gebeurtenis kunt koppelen, zoals het wijzigen van de cel.
Je moet dus listeners toevoegen die in de gaten houden of de cel gewijzigd wordt etc etc.

Daar ben ik nog niet uit
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan