Elegantere Lösung!

DPunch · Beitrag von **DPunch** » Mi, 02.06.2010 21:34

Aloha

Ob die Lösung elegant ist, weiss ich nicht, aber so sollte es auf jeden Fall funktionieren, wenn Du die Schaltflächen-Namen immer mit einer entsprechenden Nummer enden lässt (von 1 - x) und jeder Schaltfläche das Makro "WhateverButtonPressed" zuweist.

Code: Alles auswählen

Private Const nSpaltenabstand as Integer = 12
Private Const sSourceTableName as String = "Tabelle1_2"

Sub WhateverButtonPressed(oEvt)	
	oDoc = thisComponent
	oSheet = oDoc.CurrentController.ActiveSheet
	sButtonName = oEvt.Source.Model.Name

	nDigitCount = GetDigitsCountOnEndOfString(sButtonName)
	If nDigitCount = 0 Then Exit Sub
	nModifikator = CInt(Right(sButtonName,nDigitCount))
	
	oSheet.getCellByPosition(1,1).FormulaLocal = GetNewFormulaString("B1",nModifikator)
	oSheet.getCellByPosition(1,5).FormulaLocal = GetNewFormulaString("B4",nModifikator)
	oSheet.getCellByPosition(2,5).FormulaLocal = GetNewFormulaString("C4",nModifikator)
	oSheet.getCellByPosition(3,5).FormulaLocal = GetNewFormulaString("D4",nModifikator)
	oSheet.getCellByPosition(4,5).FormulaLocal = GetNewFormulaString("E4",nModifikator)
	oSheet.getCellByPosition(5,5).FormulaLocal = GetNewFormulaString("F4",nModifikator)
	oSheet.getCellByPosition(6,5).FormulaLocal = GetNewFormulaString("G4",nModifikator)
	oSheet.getCellByPosition(7,5).FormulaLocal = GetNewFormulaString("H4",nModifikator)
	oSheet.getCellByPosition(8,5).FormulaLocal = GetNewFormulaString("I4",nModifikator)
	oSheet.getCellByPosition(9,5).FormulaLocal = GetNewFormulaString("J4",nModifikator)
	oSheet.getCellByPosition(10,5).FormulaLocal = GetNewFormulaString("K4",nModifikator)
	oSheet.getCellByPosition(11,5).FormulaLocal = GetNewFormulaString("L4",nModifikator)
	oSheet.getCellByPosition(12,5).FormulaLocal = GetNewFormulaString("M4",nModifikator)
End Sub

Function GetNewFormulaString(ByVal sCellName as String,ByVal nModifikator as Integer) as String
	sCellNameEnd = Right(sCellName,GetDigitsCountOnEndOfString(sCellName))
	sCellName = Left(sCellName,Len(sCellName)- Len(sCellNameEnd))
	nColumnASCII = ASC(Right(sCellName,1)) + (nModifikator - 1)*nSpaltenabstand
	If Len(sCellName) = 1 Then
		If nColumnASCII > 90 Then
			GetNewFormulaString = "=" & sSourceTableName & "." & "A" & Chr(64 + (nColumnASCII Mod 90)) & sCellNameEnd
		Else
			GetNewFormulaString = "=" & sSourceTableName & "." & Chr(nColumnASCII) & sCellNameEnd
		End If
	Else
		If nColumnASCII > 90 Then
			GetNewFormulaString = "=" & sSourceTableName & "." & Chr(ASC(Left(sCellName,1))+1) & Chr(64 + (nColumnASCII Mod 90)) & sCellNameEnd
		Else
			GetNewFormulaString = "=" & sSourceTableName & "." & Left(sCellName,1) & Chr(nColumnASCII) & sCellNameEnd
		End If
	End If
End Function

Function GetDigitsCountOnEndOfString(sString as String) as Integer
	For x = Len(sString) To 1 Step -1
		If NOT isNumeric(Mid(sString,x,1)) Then Exit For
	Next x
	GetDigitsCountOnEndOfString = Len(sString) - x
End Function

DPunch · Beitrag von **DPunch** » Do, 03.06.2010 03:22

Aloha

Ja, den Fehler kann ich mir erklären.
Ich habe zu kurz gegriffen und schlichtweg vergessen, dass man auch mehrmals über das "Z" hinausschiessen kann.
Wenn Du "GetNewFormulaString" folgendermassen anpasst, sollte es funktionieren - ich bin allerdings jetzt zu Hause und kann das daher nicht mehr testen, insofern ist es es nur eine ungefähre Idee.

Code: Alles auswählen

Function GetNewFormulaString(ByVal sCellName as String,ByVal nModifikator as Integer) as String
	Dim nColumnASCII as Integer, sCellNameEnd as String
	sCellNameEnd = Right(sCellName,GetDigitsCountOnEndOfString(sCellName))
	sCellName = Left(sCellName,Len(sCellName)- Len(sCellNameEnd))
	nColumnASCII = ASC(Right(sCellName,1)) + (nModifikator - 1)*nSpaltenabstand
	If Len(sCellName) = 1 Then
		If nColumnASCII > 90 Then
			GetNewFormulaString = "=" & sSourceTableName & "." & Chr(64 + CInt(nColumnASCII / 90))  & Chr(64 + (nColumnASCII Mod 90 Mod 26)) & sCellNameEnd
		Else
			GetNewFormulaString = "=" & sSourceTableName & "." & Chr(nColumnASCII) & sCellNameEnd
		End If
	Else
		If nColumnASCII > 90 Then
			GetNewFormulaString = "=" & sSourceTableName & "." & Chr(ASC(Left(sCellName,1))+1) & Chr(64 + (nColumnASCII Mod 90 Mod 26)) & sCellNameEnd
		Else
			GetNewFormulaString = "=" & sSourceTableName & "." & Left(sCellName,1) & Chr(nColumnASCII) & sCellNameEnd
		End If
	End If
End Function

DPunch · Beitrag von **DPunch** » Fr, 04.06.2010 20:05

Aloha

Prinzipiell war das immer noch der gleiche Fehler, auf ein Neues:

Code: Alles auswählen

Function GetNewFormulaString(ByVal sCellName as String,ByVal nModifikator as Integer) as String
	Dim nCount as Integer, sCellNameEnd as String
	   
	sCellNameEnd = Right(sCellName,GetDigitsCountOnEndOfString(sCellName))
	sCellName = Left(sCellName,Len(sCellName)- Len(sCellNameEnd))
	
	Dim sPrefix as String : sPrefix = ""
	
	nCount = ASC(Right(sCellName,1)) + (nModifikator - 1)*nSpaltenabstand - 65
	If nCount > 26 Then
		sPrefix = Chr(64 + Fix(nCount / 26))
		nCount = nCount Mod 26
	End If
	
	GetNewFormulaString = "=" & sSourceTableName & "." & sPrefix & Chr(65 + nCount) & sCellNameEnd
End Function

Karolus · Beitrag von **Karolus** » So, 06.06.2010 07:45

Hallo
Ich steuere mal eine Function bei die einen Spaltenindex in die entsprechende Spaltenbezeichnung umrechnet, zb.
abc(1020) → ergibt 'AMF'

Code: Alles auswählen

function abc( n as integer) as string
if n < 26 then
	abc = chr(64+n)
else
	abc = abc( int( n/26)) & chr( 64 +(n mod 26))
end if
end function

Gruß Karo

turtle47 · Beitrag von **turtle47** » So, 06.06.2010 09:04

Hallo Zusammen,

hier mal mein Lösungsansatz:

Den Wert für das Offset schreibt man in das Feld "Zusatzinformationen" bei den Eigenschaften des Buttons.

Also die Werte von 1 bis ......

Folgender Code sollte dann funktionieren:

Code: Alles auswählen

Sub WhateverButtonPressed(oEvt)
	dim Celloffset as Integer
	oDoc = thisComponent
	oSheet = oDoc.CurrentController.ActiveSheet
	Celloffset = oEvt.Source.Model.Tag
	Cells = Array("B2","B6","C6","D6","E6","F6","G6","H6","I6","J6","K6","L6","M6")
	K = 1
	for i = 0 To uBound(Cells)
	oCell = oSheet.getCellRangebyName(Cells(i)
	oColumn = oCell.CellAddress.Column
	oRow = oCell.CellAddress.Row -K
	intCol = Celloffset * 12 + oColumn
	oCell1 = oSheet.getCellByPosition(intCol -12,oRow)
	NewCell = Split(oCell1.AbsoluteName,".")
	oCell.FormulaLocal = "=Tabelle1_2." & NewCell(1)
	K = 2
	next i	
End Sub

Viel Erfolg.

Jürgen

Karolus · Beitrag von **Karolus** » So, 06.06.2010 11:19

Hallo
@Jürgen
Ja, du hast Recht,deine Lösung funktioniert als einzige fehlerfrei, meine obige Function scheitert auch an den Positionen an die ein "der Null entsprechendes Zeichen" hingehören würde.

Gruß Karo

turtle47 · Beitrag von **turtle47** » So, 06.06.2010 13:00

Hi Uwe,

retuwe61 hat geschrieben:was jedoch durch das 2. $-Zeichen in den Formeln verhindert wird. (Okay, Ich würde das vorher - quasi als Zwischenschritt - durch ein Makro löschen lassen)

Die "$" bekommst Du direkt weg mit:

Code: Alles auswählen

Sub WhateverButtonPressed(oEvt)
	GlobalScope.BasicLibraries.LoadLibrary("Tools")
	dim Celloffset as Integer
	oDoc = thisComponent
	oSheet = oDoc.CurrentController.ActiveSheet
	Celloffset = oEvt.Source.Model.Tag
	Cells = Array("B2","B6","C6","D6","E6","F6","G6","H6","I6","J6","K6","L6","M6")
	K = 1
	for i = 0 To uBound(Cells)
	oCell = oSheet.getCellRangebyName(Cells(i)
	oColumn = oCell.CellAddress.Column
	oRow = oCell.CellAddress.Row -K
	intCol = Celloffset * 12 + oColumn
	oCell1 = oSheet.getCellByPosition(intCol -12,oRow)
	NewCell = Split(oCell1.AbsoluteName,".")	
	FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
	aResult=FuncAcc.callFunction("SUBSTITUTE", array(NewCell(1) ,"$",""))	
	oCell.FormulaLocal = "=Tabelle1_2." & aResult
	K = 2
	next i	
End Sub

retuwe61 hat geschrieben:2) Wie eingangs beschrieben müssen die Zellen F6 und G6 leer bleiben. Daraus ergibt sich:
Bei Button 1, Zelle H6: "=Tabelle1_2.F4" / Zelle I6: "=Tabelle1_2.F4" .../ Zelle O6: =$Tabelle1_2.M4
Bei Button 2, Zelle H6: "=Tabelle1_2.R4" ...
Bei Button 3, Zelle H6: "=Tabelle1_2.AD4"

Kriege ich jetzt keinen Kopf mehr drann. Ging Gong, Besuch steht vor der Tür.

Jürgen

turtle47 · Beitrag von **turtle47** » So, 06.06.2010 16:24

Hallo Uwe,

retuwe61 hat geschrieben:Bei Button 1, Zelle H6: "=Tabelle1_2.F4" / Zelle I6: "=Tabelle1_2.F4" .../ Zelle O6: =$Tabelle1_2.M4

irgendwie verwirrt mich das.

Vielleicht liegt das aber nur an dem guten Mittagessen.

Ich habe es jetzt mal so gemacht:

Code: Alles auswählen

Sub WhateverButtonPressed(oEvt)
	GlobalScope.BasicLibraries.LoadLibrary("Tools")
	dim Celloffset as Integer
	oDoc = thisComponent
	oSheet = oDoc.CurrentController.ActiveSheet
	Celloffset = oEvt.Source.Model.Tag
	Cells = Array("B2","B6","C6","D6","E6","F6","G6","H6","I6","J6","K6","L6","M6")
	cCol = Array (1,1,2,3,4,7,8,9,10,11,12,13,14)
	K = 1
	for i = 0 To uBound(Cells)
	oCell = oSheet.getCellRangebyName(Cells(i)
	oColumn = oCell.CellAddress.Column
	oRow = oCell.CellAddress.Row -K
	intCol = Celloffset * 12 + oColumn
	oCell1 = oSheet.getCellByPosition(intCol -12,oRow)
	NewCell = Split(oCell1.AbsoluteName,".")	
	FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
	aResult=FuncAcc.callFunction("SUBSTITUTE", array(NewCell(1) ,"$",""))
	oSheet.getCellByPosition(cCol(i),oRow+K).FormulaLocal = "=Tabelle1_2." & aResult 	
	K = 2
	next i
End Sub

Vielleicht ist es ja sogar richtig.

Jürgen

turtle47 · Beitrag von **turtle47** » So, 06.06.2010 20:45

[OT]

Karolus hat geschrieben:@Jürgen
Ja, du hast Recht,

retuwe61 hat geschrieben:Klar, du hast Recht:

Könnt ihr das bitte mal meiner Frau erklären.

[OT/]

DPunch · Beitrag von **DPunch** » Di, 08.06.2010 21:39

Aloha

DPunch hat geschrieben:Aloha
Ob die Lösung elegant ist, weiss ich nicht...

Als hätte ich es geahnt - die Lösung von turtle ist natürlich um einiges eleganter und vor allem intelligenter als mein Rumgestocher.

Also: Jürgen hat Recht

turtle47 · Beitrag von **turtle47** » Do, 10.06.2010 22:39

Nabend Uwe,

retuwe61 hat geschrieben:Hat jemand eine Idee?

Wäre schlecht wenn uns die Ideen ausgehen würden:

Code: Alles auswählen

Sub CopyRange(oEvt)
	dim Celloffset as Integer
	oDoc = thisComponent
	oSheet = oDoc.Sheets().getbyname("Tabelle1_2")
	oSheetGoal = oDoc.Sheets().getbyname("Tabelle1_3")
	Celloffset = oEvt.Source.Model.Tag
	nCelloffset = Celloffset -1
	cCols = Array (1,2,5,6)
	for i = 0 To uBound(cCols)
	intCol = nCelloffset * 12 + cCols(i)
	oCellRange = oSheet.getCellRangeByPosition(intCol,0,intCol,65535).getdataarray
	oSheetGoal.getCellRangeByPosition(intCol,0,intCol,65535).setdataarray(oCellRange)
	next i
	MsgBox "Done ",64,"Copy Range"
End Sub

Bist Du sicher, dass die komplette Spalte kopiert werden muss?

Viel Erfolg.

Jürgen

OpenOffice.info

Elegantere Lösung!

Re: Elegantere Lösung?

Re: Elegantere Lösung?

Re: Elegantere Lösung?

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!

Re: Elegantere Lösung!