Umstellung von Excel auf Calc (Makro)

[toO231]

Hallo zusammen,

wie man an meinem Profil sehen kann bin ich noch recht neu hier und da hätte ich gleich mal ne frage....

also wir wollen bei uns von MS Office auf Open Office umstellen, daher hab ich ein paar fragen bezüglich Makros in Excel...

Ich habe mir jetzt eine Tabelle von uns genommen und wollte diese in calc zum laufen bringen, nun hab ich einen absende Button auf meiner ersten Mappe, und dort ist ein Makro hinterlegt, wie ich schon weiß funktionieren MSO Makros unter OO Basic nicht... könnte mir jemand mal anhand dieses Beispiels erläutern wie das mit den Buttons funktioniert ?

Bei diesem Absenden Button werden die Daten aus bestimmten Zellen in eine andere Mappe und da immer in die nächste Zeile.... hier mal der Code ich Versteh noch nicht ganz so was falsch ist und welche Funktionen ich ersetzen muss :/

Vielen Dank schonmal !!!

Code: Alles auswählen

Sub datenübernahme()

Dim a, b, c, d, e, f, g, h
Dim Z As Integer

If (Range("B7") = "Schule") Then

a = Range("b5")
b = Range("b6")
c = Range("b8")
d = Range("b9")

Application.ScreenUpdating = False
Sheets(2).Select
Z = Sheets(2).Range("a65536").End(xlUp).Row
Sheets(2).Cells(Z + 1, 1).Select
ActiveCell.Value = a
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = b
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = c
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = d
ActiveCell.Offset(0, 1).Range("A1").Select

Sheets(1).Select

ElseIf (Range("B7") = "Sporthalle") Then

a = Range("b5")
b = Range("b6")
e = Range("b10")
f = Range("b11")
g = Range("b12")
h = Range("b13")

Application.ScreenUpdating = False
Sheets(6).Select
Z = Sheets(6).Range("a65536").End(xlUp).Row
Sheets(6).Cells(Z + 1, 1).Select
ActiveCell.Value = a
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = b
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = e
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = f
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = g
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Value = h
ActiveCell.Offset(0, 1).Range("A1").Select

Sheets(1).Select

End If

End Sub

[toO231]

hm keiner ne idee ?

[bst]

Hi,

in VBA sollte das M.E. - besser - so aussehen:

Code: Alles auswählen

Option Explicit

Sub DatenUebernahme()
   Dim Z As Long
   
   Select Case Worksheets(1).Range("B7").Value
      Case "Schule"
         With Worksheets(2)
            Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(Z, 1).Value = Range("b5").Value
            .Cells(Z, 2).Value = Range("b6").Value
            .Cells(Z, 3).Value = Range("b8").Value
            .Cells(Z, 4).Value = Range("b9").Value
         End With
   
      Case "Sporthalle"
         With Worksheets(6)
            Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(Z, 1).Value = Range("b5").Value
            .Cells(Z, 2).Value = Range("b6").Value
            .Cells(Z, 3).Value = Range("b10").Value
            .Cells(Z, 4).Value = Range("b11").Value
            .Cells(Z, 5).Value = Range("b12").Value
            .Cells(Z, 7).Value = Range("b13").Value
         End With
   End Select
End Sub

In OO Basic kannst Du das mal so versuchen.

Code: Alles auswählen

Option Explicit

Sub DatenUebernahme()
	Dim Z As Long
	Dim oSrcSheet As Object, oDstSheet As Object
	
	oSrcSheet = ThisComponent.Sheets(0)
	Select Case oSrcSheet.getCellRangeByName("b7").String
		case "Schule"
			oDstSheet = ThisComponent.sheets(1)
			Z = getLastRowInColumn(oDstSheet, 0) + 1
			prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b6"), oDstSheet.getCellByPosition(1,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b8"), oDstSheet.getCellByPosition(2,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b9"), oDstSheet.getCellByPosition(3,Z)
	
		Case "Sporthalle"
			oDstSheet = ThisComponent.sheets(5)
			Z = getLastRowInColumn(oDstSheet, 0) + 1
			prcCopyValue oSrcSheet.getCellRangeByName("b5"),  oDstSheet.getCellByPosition(0,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b6"),  oDstSheet.getCellByPosition(1,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b10"), oDstSheet.getCellByPosition(2,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b11"), oDstSheet.getCellByPosition(3,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b12"), oDstSheet.getCellByPosition(4,Z)
			prcCopyValue oSrcSheet.getCellRangeByName("b13"), oDstSheet.getCellByPosition(6,Z)
	End Select
End Sub

Function getLastRowInColumn(oSheet as Object, iColumn as integer) as Long
	dim oUsedCells as Object
	
	oUsedCells = oSheet.Columns(iColumn).queryContentCells(23)
	if oUsedCells.Count = 0 Then
	   getLastRowInColumn = -1
	else
	   getLastRowInColumn = oUsedCells.RangeAddresses(oUsedCells.Count-1).endRow
	endif
End Function

Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
	dim arData as Variant
	
	arData = oSrcRange.getDataArray()
	oDstRange.setDataArray(arData)
End Sub

[toO231]

vielen dank schonmal,

ich versuch mal den Basic code nachzuvollziehen...aber es erscheint mir irgendwie komplizierter :/

[toO231]

Super danke das hat auf Anhieb geklappt..
könntest du mir den teil hier mal kurz erläutern ? Ich hab keine Ahnung was dieser abschnitt macht :/

Code: Alles auswählen

Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
   dim arData as Variant
   
   arData = oSrcRange.getDataArray()
   oDstRange.setDataArray(arData)
End Sub

[bst]

Hi,

da kopiere ich mit Hilfe eines Arrays einen Quellbereich in einen Zielbereich um.

Solange man innerhalb einer Datei bleibt sollte das auch einfacher gehen, siehe hierzu:

http://www.dannenhoefer.de/faqstarbasic ... eren..html

cu, Bernd

[toO231]

Ok da steht ja schonmal viel danke
ein frage hätte ich noch, wie kann ich denn die zelle "b7" ändern, sodass ich da ne listbox/listenfeld habe ? Ich hab noch nicht ganz verstanden wie ich den markierten wert aus einer listbox übertragen kann / als case anweisung verwenden kann

Code: Alles auswählen

Select Case oSrcSheet.getCellRangeByName("b7").String

und komischerweise ist die listbox automatisch ausgegraut, in den Einstellung steht aber aktiviert

danke

[bst]

Hi,

vergib der Liste den Namen "myList", damit geht hier:

Code: Alles auswählen

	dim oList as Object
	
	oList = ThisComponent.sheets(0).drawPage.Forms.getByIndex(0).getByName("myList")
	print oList.currentValue

HTH, Bernd

[toO231]

ja ok das hat funktioniert, aber du hast auch keine Ahnung warum das Listenfeld immer ausgegraut ist nachdem ein Eintrag gemacht wurde und man von einer mapper zur anderen springt ?
und mir ist noch aufgefallen, das die listbox beim starten der Datei leer ist , da ist nicht ein entrag dann drin, er zieht sich den eintrag aus einer kleinen odb, da sind 3 tabellen drin und von einer zieht er sich die daten (sollte er zumindist)
und ich hätte noch eine Frage:

und zwar habe ich jetzt auch eine Listbox und den werte möchte ich in eine bestimmte zeile kopieren nur funktioniert das noch nicht so ganz

Code: Alles auswählen

 prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
         prcCopyValue o2List.currentValue, oDstSheet.getCellByPosition(1,Z)

die Auswertung für oList2 funktioniert, also da steht schon der ausgewählte wert drin
aber weiß noch nicht wie ich das übertrage

[bst]

Morgen,

aber du hast auch keine Ahnung warum das Listenfeld immer ausgegraut ist nachdem ein Eintrag gemacht wurde und man von einer mapper zur anderen springt ?

Nein.

prcCopyValue o2List.currentValue, oDstSheet.getCellByPosition(1,Z)

Das geht nicht. prcCopyValue erwartet zwei Objekte vom Typ ScCellObj bzw. ScCellRangeObj.

Nimm mal:

Code: Alles auswählen

oDstSheet.getCellByPosition(1,Z).String = o2List.currentValue

HTH, Bernd

[toO231]

danke hat sehr gut funktioniert

[toO231]

hm ich hab wieder ne frage

ich bekomm :/ einfach kein makro hin um bestimmte zellen zu lernen

noch ne idee ?

[bst]

Hi,

was meinst Du damit?

cu, Bernd

[toO231]

bin schon fündig geworden


Sub loeschen()

ThisComponent.sheets(0).getCellRangebyName("B8:B13").clearContents(5)
ThisComponent.sheets(0).getCellRangebyName("B27:B32").clearContents(5)
ThisComponent.sheets(0).getCellRangebyName("B46:B49").clearContents(5)
ThisComponent.sheets(0).getCellRangebyName("B60:B61").clearContents(5)

End Sub

danke dir trotzdem