Da hatte sich bei den "If"-Abfragen der Fehlerteufel eingeschlichen, es muss immer ">= 0.5" heißen bei der Rundung. Ist unten korrigiert ...

------ Originalnachricht ------
Von: "OoOHWHOoO" <ooohwh...@t-online.de>
An: users@de.libreoffice.org
Cc: "OoOHWHOoO" <ooohwh...@t-online.de>
Gesendet: 11.06.2017 20:02:48
Betreff: Re: [de-users] LO 5.3.3.2 - Basic Makro - unoCommand - RowHeight und ColumnWidth - Fehlfunktion

Hallo,

im Kontext der Änderungen ab "LO 5.3.x.x" bezüglich ".uno:ColumnWidth" und ".uno:RowHeight", insbesondere der neuen Maßeinheit "twip", hat sich in der Anwendung gezeigt, dass noch ein paar Details zu beachten sind (siehe Makros unten).

Gruß
Hans-Werner


Option Explicit

'  Hinweise zu ".uno:ColumnWidth" und ".uno:RowHeight":
'
' + Der Fehler ist behoben ( bugs.documentfoundation.org/show_bug.cgi?id=107806 ). ' + Getestet mit "LO 5.3.3.2 (x64)" @ "Windows 7 Home Premium 64-bit".
'  + Neue Aufrufform: Jetzt sind 2 Parameter notwendig.
' + Neue Maßeinheit "twip": 1 [mm] = 56.6928 [twip] (TWentieth of an Inch Point)
'  + Der Spaltenindex beginnt mit 1: Column=1 => Column "A"
'  + Der Zeilenindex  beginnt mit 1: Row   =1 => Row    "1"
'  + PV(1).Value erwartet einen ganzzahligen Wert.

Sub Cell_ColumnWidth_RowHeight

'  Das Makro erzeugt
'
'  + Eine Spalte "C"  der Breite = 16.7 mm = 1.67 cm.
'  + eine Zeile  "3"  der Höhe   = 16.7 mm = 1.67 cm.
'  + eine Zelle  "C3" der Breite = 16.7 mm = 1.67 cm
'                     und
'                     der Höhe   = 16.7 mm = 1.67 cm.

  Dim oC as Object : oC = ThisComponent.CurrentController
  Dim oF as Object : oF = oC.Frame
Dim oD as Object : oD = createUnoService("com.sun.star.frame.DispatchHelper")

  Dim PV(1) as New com.sun.star.beans.PropertyValue

  Dim Column      as Integer : Column    = 3
  Dim Width_mm    as Single  : Width_mm  = 16.7
  Dim Width_twip  as Integer

  Width_twip = Fix(Width_mm*56.6928)
  If ( ((Width_mm*56.6928)-(Fix(Width_mm*56.6928))) >= 0.5 ) Then
     Width_twip = Width_twip+1
  EndIf

MsgBox ("1 mm = 56,6928 twip | Width_mm = " & Width_mm & " mm | " & _ "Width_twip = " & Width_twip & " twip",0,"Makro: Cell_ColumnWidth_RowHeight")

  PV(0).Name = "Column"
  PV(0).Value = Column
  PV(1).Name = "Width"
  PV(1).Value = Width_twip

  oD.executeDispatch(oF,".uno:ColumnWidth","",0,PV())

  Dim Row         as Integer : Row       = 3
  Dim Height_mm   as Single  : Height_mm = 16.7
  Dim Height_twip as Integer

  Height_twip = Fix(Height_mm*56.6928)
  If ( ((Height_mm*56.6928)-(Fix(Height_mm*56.6928))) >= 0.5 ) Then
     Height_twip = Height_twip+1
  EndIf

MsgBox ("1 mm = 56,6928 twip | Height_mm = " & Height_mm & " mm | " & _ "Height_twip = " & Height_twip & " twip",0,"Makro: Rows_RowHeight")

  PV(0).Name = "Row"
  PV(0).Value = Row
  PV(1).Name = "Height"
  PV(1).Value = Height_twip

  oD.executeDispatch(oF,".uno:RowHeight","",0,PV())

End Sub

Sub Columns_ColumnWidth

' Das Makro erzeugt 5 Spalten ("F" "G" "H" "I" "J" ) der Breite 8.9 mm = 0.89 cm.

  Dim oC as Object : oC = ThisComponent.CurrentController
  Dim oF as Object : oF = oC.Frame
Dim oD as Object : oD = createUnoService("com.sun.star.frame.DispatchHelper")

  Dim PV(1) as New com.sun.star.beans.PropertyValue

  Dim Column       as Integer
  Dim Column_first as Integer : Column_first = 6
  Dim Column_last  as Integer : Column_last  = 10
  Dim Width_mm     as Single  : Width_mm     = 8.9
  Dim Width_twip   as Integer

  Width_twip = Fix(Width_mm*56.6928)
  If ( ((Width_mm*56.6928)-(Fix(Width_mm*56.6928))) >= 0.5 ) Then
     Width_twip = Width_twip+1
  EndIf

MsgBox ("1 mm = 56,6928 twip | Width_mm = " & Width_mm & " mm | " & _ "Width_twip = " & Width_twip & " twip",0,"Makro: Columns_ColumnWidth")

  PV(0).Name = "Column"
  PV(1).Name = "Width"
  PV(1).Value = Width_twip

  For Column = Column_first To Column_last Step 1
     PV(0).Value = Column
     oD.executeDispatch(oF,".uno:ColumnWidth","",0,PV())
  Next

End Sub

Sub Rows_RowHeight

' Das Makro erzeugt 5 Zeilen ("6" "7" "8" "9" "10" ) der Höhe 7.4 mm = 0.74 cm.

  Dim oC as Object : oC = ThisComponent.CurrentController
  Dim oF as Object : oF = oC.Frame
Dim oD as Object : oD = createUnoService("com.sun.star.frame.DispatchHelper")

  Dim PV(1) as New com.sun.star.beans.PropertyValue

  Dim Row         as Integer
  Dim Row_first   as Integer : Row_first = 6
  Dim Row_last    as Integer : Row_last  = 10
  Dim Height_mm   as Single  : Height_mm = 7.4
  Dim Height_twip as Integer

  Height_twip = Fix(Height_mm*56.6928)
  If ( ((Height_mm*56.6928)-(Fix(Height_mm*56.6928))) >= 0.5 ) Then
     Height_twip = Height_twip+1
  EndIf

MsgBox ("1 mm = 56,6928 twip | Height_mm = " & Height_mm & " mm | " & _ "Height_twip = " & Height_twip & " twip",0,"Makro: Rows_RowHeight")

  PV(0).Name = "Row"
  PV(1).Name = "Height"
  PV(1).Value = Height_twip

  For Row = Row_first To Row_last Step 1
     PV(0).Value = Row
     oD.executeDispatch(oF,".uno:RowHeight","",0,PV())
  Next

End Sub

-- Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme? http://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: http://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: http://listarchives.libreoffice.org/de/users/
Alle E-Mails an diese Liste werden unlöschbar öffentlich archiviert


--
Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme? 
http://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: http://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: http://listarchives.libreoffice.org/de/users/
Alle E-Mails an diese Liste werden unlöschbar öffentlich archiviert

Antwort per Email an