LibreOffice-Forum

Hallo,
kann mir jemand bitte ein VBA Exel Code für LO Calc umschreiben ?
Ich hab mit einem online Konverter versucht, und leider funktioniert es nicht.
Egal was ich versucht habe bekomme ich immer wieder Fehlermeldungen.
Im Exel unter Windows funktioniert einwandfrei, aber bin kein Windows Benutzer mehr.
Was ich möchte, wenn doppelklick links soll die Zahl in der Zelle um ein Punkt erhöht werden,
wenn rechts klick soll die Zahl in der Zelle um ein Punk gesenkt werden.

Vielen vielen Dank im Voraus
Gruß Criss

Hier VBA Code für Exel
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E4:E24")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
' Zeile 4
If Not Intersect(Target, Range("G4:U4")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
' Zeile 7
If Not Intersect(Target, Range("G7:U7")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Intersect(Target, Range("E4:E24")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If
' Zeile 4
If Not Intersect(Target, Range("G4:U4")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If
' Zeile 7
If Not Intersect(Target, Range("G7:U7")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If

und hier nach "Konvertierung"

Option VBASupport 1
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1), Cancel As Boolean)
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("E4:E24")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
' Zeile 4
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("G4:U4")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
' Zeile 7
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("G7:U7")) Is Nothing Then
Target.Value = Target + 1
Cancel = True
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel. oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1), Cancel As Boolean)
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("E4:E24")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If
' Zeile 4
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("G4:U4")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If
' Zeile 7
If Not Intersect(Target, oSheet oSheet = ThisComponent.CurrentController.ActiveSheetoSheet.getCellRangeByName($1)("G7:U7")) Is Nothing Then
Target.Value = Target - 1
Cancel = True
End If
End Sub

Hallo,
weil du so nett fragst ...

Code: Alles auswählen

Sub doppelklick (oevent) as boolean

	bereiche=array("E4:E24","G4:U4","G7:U7")
	ziel=false
	for i=0 to ubound(bereiche)
		ziel=ziel+oevent.spreadsheet.getcellrangebyname(bereiche(i)).queryintersection(oevent.rangeaddress).count
	next
	if ziel>0 then
		oevent.value=oevent.value+1
	end if
	'die folgende Zeile dient nur der "Freigabe" des Cursors nach dem Klicken
	doppelklick=true

End Sub

Sub rechtsklick (oevent) as boolean

	bereiche=array("E4:E24","G4:U4","G7:U7")
	ziel=false
	for i=0 to ubound(bereiche)
		ziel=ziel+oevent.spreadsheet.getcellrangebyname(bereiche(i)).queryintersection(oevent.rangeaddress).count
	next
	if ziel>0 then
		oevent.value=oevent.value-1
	end if	
	'die folgende Zeile dient nur der "Freigabe" des Cursors nach dem Klicken
	rechtsklick=true

End Sub

Die Makros müssen dann noch an das jeweilige Tabellenereignis gebunden werden (Rechtsklick auf den Tab -> Tabellenereignisse ...)

Hallo Mikele,

du bist echt der Hammer, es funktioniert einwandfrei.
Es ist genau was ich brauche.

Zum Glück gibt es Menschen wie du.

Vielen, vielen Dank.

Gruß Criss

LibreOffice-Forum

VBA Exel Code für LO Calc umschreiben

VBA Exel Code für LO Calc umschreiben

Re: VBA Exel Code für LO Calc umschreiben

Re: VBA Exel Code für LO Calc umschreiben