von moritz » Mo, 10.12.2007 23:54
Hier mal das ganze Makro. Ich habe OO 2.3.1, bis jetzt nur unter XP. Unter SuSE hab ich das ganze noch nicht getestet. Egal, was ich bei CharHeight eingebe, die Textgröße bleibt unverändert, nur die vertikale Rahmengröße ändert sich.
Die Notizen werden auf zweierlei Arten angezeigt: wenn man mit der Maus darüber fährt und wenn mann "Notizen anzeigen" einstellt. Wenn man die Notizen manuell erstellt, werden sie bei beiden Anzeigearten in der gleichen Größe dargestellt. Bei mit dagegen beim Darüberfahren mit der Maus viel zu groß, bei "Notizen anzeigen" jedoch richtig.
Vielleicht ist hier doch ein bug in Starbasic.
sub Notiz
'Fügt eine Notiz mit dem aktuellen Datum in das aktuelle Feld ein.
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oCell = oDoc.Sheets( GetPosActiveSheet(oDoc)).getCellByPosition(getColumn,Tools.getRow)
AddColoredAnnotationToCell(oCell, date(),100,200,100)
End Sub
Function AddColoredAnnotationToCell(oCell as Object, sText as String,r as Long, g as Long,b as Long)
Dim aSize As New com.sun.star.awt.Size
Dim apoint As New com.sun.star.awt.Point
Dim cellPos, cellSize
Dim oShape as Object
Dim oText as Object
cellPos = oCell.Position
cellSize = oCell.Size
oCell.Annotation.String = sText
oShape = oCell.Annotation.AnnotationShape
'-----------------------------------------------------------------------------
oShape.FillBackground = true
oShape.FillColor = RGB(r,g,b)
oShape.FillStyle = 1
oShape.FillTransparence = 0
oShape.CharFontName = "Arial"
oShape.CharHeight = 8
oShape.CharScaleWidth = 100
oShape.TextLeftDistance =100
oShape.TextLowerDistance =100
oShape.TextRightDistance =100
oShape.TextUpperDistance =100
'-----------------------------------------------------------------------------
asize.Height = cellSize.height
asize.Width = cellSize.width
oShape.Size = asize
oShape.SizeProtect = False
apoint.x = cellPos.x + cellSize.width + cellSize.width/4
apoint.y = cellPos.y - 2 * cellSize.height
oShape.setPosition apoint
End Function
Hier mal das ganze Makro. Ich habe OO 2.3.1, bis jetzt nur unter XP. Unter SuSE hab ich das ganze noch nicht getestet. Egal, was ich bei CharHeight eingebe, die Textgröße bleibt unverändert, nur die vertikale Rahmengröße ändert sich.
Die Notizen werden auf zweierlei Arten angezeigt: wenn man mit der Maus darüber fährt und wenn mann "Notizen anzeigen" einstellt. Wenn man die Notizen manuell erstellt, werden sie bei beiden Anzeigearten in der gleichen Größe dargestellt. Bei mit dagegen beim Darüberfahren mit der Maus viel zu groß, bei "Notizen anzeigen" jedoch richtig.
Vielleicht ist hier doch ein bug in Starbasic.
sub Notiz
'Fügt eine Notiz mit dem aktuellen Datum in das aktuelle Feld ein.
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oCell = oDoc.Sheets( GetPosActiveSheet(oDoc)).getCellByPosition(getColumn,Tools.getRow)
AddColoredAnnotationToCell(oCell, date(),100,200,100)
End Sub
Function AddColoredAnnotationToCell(oCell as Object, sText as String,r as Long, g as Long,b as Long)
Dim aSize As New com.sun.star.awt.Size
Dim apoint As New com.sun.star.awt.Point
Dim cellPos, cellSize
Dim oShape as Object
Dim oText as Object
cellPos = oCell.Position
cellSize = oCell.Size
oCell.Annotation.String = sText
oShape = oCell.Annotation.AnnotationShape
'-----------------------------------------------------------------------------
oShape.FillBackground = true
oShape.FillColor = RGB(r,g,b)
oShape.FillStyle = 1
oShape.FillTransparence = 0
oShape.CharFontName = "Arial"
oShape.CharHeight = 8
oShape.CharScaleWidth = 100
oShape.TextLeftDistance =100
oShape.TextLowerDistance =100
oShape.TextRightDistance =100
oShape.TextUpperDistance =100
'-----------------------------------------------------------------------------
asize.Height = cellSize.height
asize.Width = cellSize.width
oShape.Size = asize
oShape.SizeProtect = False
apoint.x = cellPos.x + cellSize.width + cellSize.width/4
apoint.y = cellPos.y - 2 * cellSize.height
oShape.setPosition apoint
End Function