Список форумов Форум Libreoffice

Форум Libreoffice

Добро пожаловать на Форум Libreoffice!
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

English French German Italian Portuguese Russian Spanish
Создание таблицы в документе Writer (www.oooforum.org)

 
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic
Предыдущая тема :: Следующая тема  
Автор Сообщение
neft



Репутация: 0    

Зарегистрирован: 19.10.2011
Сообщения: 28

СообщениеДобавлено: Вт Ноя 22, 2011 5:03 pm    Заголовок сообщения: Создание таблицы в документе Writer (www.oooforum.org) Ответить с цитатой

Не мог не скопировать с форума OOoForum.org http://www.oooforum.org/forum/viewtopic.phtml?t=114379 очень содержательный и подробный пример PepeAlvarez'a о создании таблицы в документе Writer:
Код:
Option Explicit

REM This macro creates a writer document that contains a text table
REM The text table insert the following data:
REM Alumns, subjects, and the score of each alumn for each subject.

Sub Main

   CreaDocumentoWriter(5, 10)

End Sub


REM Creating the Writer document
REM The first argument is the number of alumns
REM The second argument is the number of subjects
Sub CreaDocumentoWriter (i%, j%)

   Dim sMatriz()
   Redim sMatriz (i, j)
REM After this, we should open a Calc document to drop the data in the array
REM but, for this example, we won't do it.


   Dim sTipoDoc As String
   Dim oDocumentoWriter As Object
   Dim oSinArgumentos() As new com.sun.star.beans.PropertyValue
   Dim PrinterProperties(2) As New com.sun.star.beans.PropertyValue
   Dim oCursor As Object
   Dim oEnum As Object
   Dim oCursorParrafo As Object
   Dim oText As Object

   sTipoDoc = "private:factory/swriter"
   oDocumentoWriter = StarDesktop.LoadComponentFromURL(sTipoDoc$, "_default", 0, oSinArgumentos())
REM Aplicamos el tipo de letra a todo el texto
   oDocumentoWriter.CharFontName = "Arial Narrow"
'   oDocumentoWriter.CharFontName = "LMSans10"

REM Cambiamos la horientación del papel
   PrinterProperties(0).Name = "Name"
   PrinterProperties(0).Value = "MFC8880DN"
   PrinterProperties(1).Name = "PaperFormat"
   PrinterProperties(1).Value = com.sun.star.view.PaperFormat.A4
   PrinterProperties(2).Name = "PaperOrientation"
   PrinterProperties(2).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
   oDocumentoWriter.Printer = PrinterProperties()

REM Inserting the table with data
   InsertarTablaNotas (oDocumentoWriter, sMatriz())

End Sub


REM Inserting the table with data
Sub InsertarTablaNotas(oDocumentoWriter As Object, sMatriz())

   Dim oCursor As Object
   Dim oTabla As Object
   Dim nNumeroFilas%, nNumeroColumnas%
   Dim sColorFondo$

   nNumeroFilas = UBound(sMatriz(),1) + 2
   nNumeroColumnas = UBound(sMatriz(),2) + 3

   oCursor = oDocumentoWriter.Text.createTextCursor()
   oTabla = oDocumentoWriter.createInstance("com.sun.star.text.TextTable")
   
REM Initialize the table
   oTabla.initialize(nNumeroFilas, nNumeroColumnas)
   oCursor.gotoEnd(False)
   oCursor.Setstring(CHR(13))
   oCursor.gotoEnd(False)

REM Insert the table in the document
   oDocumentoWriter.Text.insertTextContent(oCursor, oTabla, False)

REM Modify the columns size
   ModificaTamanoColumnasNotas(oTabla)

REM Modify the rows size
   ModificaTamanoFilasNotas(oTabla, nNumeroFilas)

REM Merge cells that we need
   ModificaCeldasNotas(oTabla)

REM Add borders
   AnadeBordesNotas(oTabla, nNumeroFilas, nNumeroColumnas)

REM Add format to cells
   sColorFondo = "&HE5E4E4"
   AnadeFormatoNotas(oDocumentoWriter, oTabla, nNumeroFilas, nNumeroColumnas, sColorFondo)

REM Insert data
'   InsertaDatosEnTablaNotas(oTabla, sMatriz(), nNumeroFilas, nNumeroColumnas)

REM ***********************************************************************
REM ****************  ATENTION ********************************************
REM    After formating the cell "C1", its row height changes (don't know why)
REM  so I have to take cell "C1" plus the cells bellow
REM ***********************************************************************
REM We try to change the row height equally
REM ********* Thanks to Andrew Pitonyak ***********************************
   RemodificaCeldasNotas(oDocumentoWriter, oTabla, nNumeroColumnas)

End Sub


REM Modifying the columns size
Sub ModificaTamanoColumnasNotas(oTabla As Object)
   Dim oTCS
   Dim nSumaRelativa%
   Dim nLongitudFila%
   Dim nTamanoAsignaturas%
   Dim nProporcion
   Dim i%

   oTCS = oTabla.getPropertyValue("TableColumnSeparators")
   nLongitudFila = oTabla.getPropertyValue("TableColumnRelativeSum")

REM El tamaño de las dos primeras columnas son fijas (el 50% del tamaño de la tabla)
   nSumaRelativa = nLongitudFila * 0.04
   oTCS(0).Position = nSumaRelativa
       
   nSumaRelativa = nSumaRelativa + nLongitudFila * 0.46
   oTCS(1).Position = nSumaRelativa

REM El tamaño de las columnas de las asignaturas se calcula en base al tamaño que nos queda
   nTamanoAsignaturas = oTabla.getColumns.Count - 3
   nProporcion = 0.4 / nTamanoAsignaturas

   For i = 2 To UBound(oTCS(),1)

      nSumaRelativa = nSumaRelativa + nLongitudFila * nProporcion
      oTCS(i).Position = nSumaRelativa

   Next

   oTabla.setPropertyValue("TableColumnSeparators", oTCS)

End Sub


REM Modifying the row size
Sub ModificaTamanoFilasNotas(oTabla As Object, nNumeroFilas%)

   Dim oFilas As Object
   Dim oFila As Object
   Dim i%

   oFilas = oTabla.getRows

   For i = 0 To 1
      oFila = oFilas.getByIndex(i)
' VARIABLE: optimal, FIX: fix height, MIN: minimum height
      oFila.SizeType = com.sun.star.text.SizeType.FIX
      oFila.Height = 500 ' in 1/100 th mm
   Next



   For i = 2 To (nNumeroFilas - 1)
      oFila = oFilas.getByIndex(i)
' VARIABLE: optimal, FIX: fix height, MIN: minimum height
      oFila.SizeType = com.sun.star.text.SizeType.FIX
      oFila.Height = 418 ' in 1/100 th mm
   Next
   
End Sub


REM Merging the cells we need
Sub ModificaCeldasNotas(oTabla As Object)

   Dim oCursorTabla As Object
   Dim oFilas As Object
   Dim oColumnas As Object
   Dim nNumeroColumnas%, nNumeroFilas%

   oFilas = oTabla.getRows
   oColumnas = oTabla.getColumns

   nNumeroColumnas = oColumnas.Count
   nNumeroFilas = oFilas.Count
   
REM Unimos las celdas
REM "Nº Orden"
   oCursorTabla = oTabla.createCursorByCellName("A1")
   oCursorTabla.goDown (1, True)
   oCursorTabla.mergeRange ()

REM "Apellidos, nombre"
   oCursorTabla.goUp (1, False)
   oCursorTabla.goRight (1, False)
   oCursorTabla.goDown (1, True)
   oCursorTabla.mergeRange ()

REM "Calificaciones obtenidas en los módulos profesionales"
   oCursorTabla.goUp (1, False)
   oCursorTabla.goRight (1, False)
   oCursorTabla.goRight ((nNumeroColumnas - 4), True)
   oCursorTabla.mergeRange ()

REM "Acceso FCT, PR"
   oCursorTabla.goRight (1, False)
   oCursorTabla.goDown (1, True)
   oCursorTabla.mergeRange ()

End Sub


REM Adding borders
Sub AnadeBordesNotas(oTabla As Object, nNumeroFilas%, nNumeroColumnas%)

   Dim x 'represents each BorderLine
   Dim v 'represents the TableBorder Object as a whole
   Dim oCelda As Object
   Dim sBorde As New com.sun.star.table.BorderLine
   Dim i%
   Dim sNombreCelda$

REM Primero, los bordes de la tabla
   v = oTabla.TableBorder
 
   x = v.TopLine        : x.OuterLineWidth = 50 : v.TopLine = x
   x = v.LeftLine       : x.OuterLineWidth = 50 : v.LeftLine = x
   x = v.RightLine      : x.OuterLineWidth = 50 : v.RightLine = x
   x = v.VerticalLine   : x.OuterLineWidth = 10 : v.VerticalLine = x
   x = v.HorizontalLine : x.OuterLineWidth = 10 : v.HorizontalLine = x
   x = v.BottomLine     : x.OuterLineWidth = 50 : v.BottomLine = x

   oTabla.TableBorder = v

REM Después, los bordes de cada celda en especial.
REM Primero la primera fila
   For i = ASC("A") To ASC("D")
      oCelda = oTabla.getCellByName(CHR(i) & "1")
      sBorde.InnerLineWidth = 50
      With oCelda
         .BottomBorder = sBorde
         .RightBorder = sBorde
      End With
   Next
REM Ahora la segunda fila
   For i = ASC("C") To ((nNumeroColumnas - 4) + ASC("C"))
      oCelda = oTabla.getCellByName(CHR(i) & "2")
      sBorde.InnerLineWidth = 50
      With oCelda
         .BottomBorder = sBorde
         .RightBorder = sBorde
      End With
   Next
REM Ahora la primera columna
   For i = 3 To (nNumeroFilas)
      oCelda = oTabla.getCellByName("A" & i)
      sBorde.InnerLineWidth = 50
      With oCelda
         .BottomBorder = sBorde
         .RightBorder = sBorde
      End With
   Next
   
End Sub


REM Formatting cells
Sub AnadeFormatoNotas(oDocumentoWriter As Object, oTabla As Object, nNumeroFilas%, nNumeroColumnas%, sColorFondo$)

   Dim sNombreCelda As String
   Dim oCelda As Object
   Dim oCursorCelda As Object
   Dim oContenidoCelda As Object
   Dim oEnum As Object
   Dim oCursorParrafo As Object
   Dim i%,j%

REM Formateamos la tabla
REM Celda "A1" (Nº de Orden)
   sNombreCelda = "A1"
   FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, "Nº de" & CHR(10) & "Orden")

REM Celda "B1" (Apellidos, Alumno)
   sNombreCelda = "B1"
   FormatoCelda(sNombreCelda, oTabla, sColorFondo, 3, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 100, 0, 0, "Apellidos, Nombre")

REM Celda "C1" (Calificaciones obtenidas...)
   sNombreCelda = "C1"
   FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, "Calificaciones obtenidas en los módulos profesionales (4)")

REM Celda "Ultima1" (Acceso FCT)
   sNombreCelda = "D1"
   FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, "Acceso" & CHR(10) & "FCT, PR (5)")

REM Celdas desde "C1.1.2" hasta "C1.1.NumAsig"
   For i = ASC("C") To ((nNumeroColumnas - 3) + ASC("C"))
      sNombreCelda = CHR (i) & "2"

      If ( (i - ASC("B")) < 10 ) Then
         FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, "0" & (i - ASC("B")))
      Else
         FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, i - ASC("B"))
      End If
   Next


REM Celdas desde "A3" hasta "A.NumAsig+3"
   For i = 3 To (nNumeroFilas)
      sNombreCelda = "A" & i
      FormatoCelda(sNombreCelda, oTabla, sColorFondo, 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, i - 2)
   Next

REM Celdas con los Alumnos
   For i = 3 To (nNumeroFilas)
      For j = ASC("B") To (ASC("B") + (nNumeroColumnas - 3))
         sNombreCelda = CHR (j) & i
         FormatoCelda(sNombreCelda, oTabla, "&HFFFFFF", 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.LEFT, 0, 0, 100, 0, "")
      Next
   Next

REM Celdas con las notas de los Alumnos
   For i = 3 To (nNumeroFilas)
      For j = ASC("C") To (ASC("C") + (nNumeroColumnas - 3))
         sNombreCelda = CHR (j) & i
         FormatoCelda(sNombreCelda, oTabla, "&HFFFFFF", 2, 6.5, com.sun.star.awt.FontWeight.NORMAL, com.sun.star.style.ParagraphAdjust.CENTER, 0, 0, 0, 0, "")
      Next
   Next
     
End Sub


REM FormatoCelda --> Da formato a una celda de una tabla de texto e inserta texto en ella.
REM 1er Parametro: nombre de la celda dentro de la tabla en notación "humana" (p.e. "A1")
REM 2º Parametro: la tabla en sí
REM 3er Parametro: Color de fondo de la celda en notación RGB en hexadecimal (HTML) precedido de "&H"
REM 4º Parametro: Orientación Vertical del texto de la celda
REM NONE = 0
REM TOP = 1
REM CENTER = 2
REM BOTTOM = 3
REM CHAR_TOP = 4
REM CHAR_CENTER = 5
REM CHAR_BOTTOM = 6
REM LINE_TOP = 7
REM LINE_CENTER = 8
REM LINE_BOTTOM = 9

REM 5º Parametro: Tamaño de la fuente
REM 6º Paremetro: Alteración de la fuente. Puede ser cualquiera de com.sun.star.awt.FontWeight
REM .DONTKNOW    The font weight is not specified/known.
REM .THIN       specifies a 50% font weight.
REM .ULTRALIGHT specifies a 60% font weight.
REM .LIGHT       specifies a 75% font weight.
REM .SEMILIGHT    specifies a 90% font weight.
REM .NORMAL    specifies a normal font weight.
REM .SEMIBOLD    specifies a 110% font weight.
REM .BOLD       specifies a 150% font weight.
REM .ULTRABOLD    specifies a 175% font weight.
REM .BLACK       specifies a 200% font weight.

REM 7º Parametro: Orientación Horizontal del texto de la celda. Puede ser cualquiera de com.sun.star.style.ParagraphAdjust
REM .LEFT       adjusted to the left border
REM .RIGHT       adjusted to the right border
REM .BLOCK       adjusted to both borders / stretched, except for last line
REM .CENTER    adjusted to the center
REM .STRETCH    adjusted to both borders / stretched, including last line

REM 8º Parametro: Distancia del margen superior de la celda
REM 9º Parametro: Distancia del margen inferior de la celda
REM 10º Parametro: Distancia del margen izquierdo de la celda
REM 11º Parametro: Distancia del margen derecho de la celda
REM 12º Parametro: Texto a incluir en la celda
Sub FormatoCelda(sNombreCelda$, oTabla, sColorFondo$, nOrientacionVertical%, fTamanoFuente!, fAlteracionFuente!, oAlineacionParrafo, nMargenSuperior%, nMargenInferior%, nMargenIzquierdo%, nMargenDerecho%,sTexto$)

   Dim oCelda As Object
   Dim oCursorCelda As Object
   Dim oContenidoCelda As Object
   Dim oEnum As Object
   Dim oCursorParrafo As Object

REM Formateamos la celda
   oCelda = oTabla.getCellByName(sNombreCelda)
   With oCelda
      .BackColor = Clng(sColorFondo)
      .TopBorderDistance = nMargenSuperior
      .BottomBorderDistance = nMargenInferior
      .LeftBorderDistance = nMargenIzquierdo
      .RightBorderDistance = nMargenDerecho
   End With
   
   oCelda.setPropertyValue("VertOrient", nOrientacionVertical)
   oCursorCelda = oCelda.createTextCursor()
   oContenidoCelda = oCelda.getText
   oEnum = oContenidoCelda.createEnumeration()
   Do While oEnum.hasMoreElements()
      oCursorParrafo = oEnum.nextElement()
      oCursorParrafo.setPropertyValue("CharHeight",fTamanoFuente)
      oCursorParrafo.setPropertyValue("CharWeight",fAlteracionFuente)
      oCursorParrafo.ParaAdjust = oAlineacionParrafo
   Loop

REM Insertamos el texto
   oCursorCelda.Setstring(sTexto)

End Sub



Sub RemodificaCeldasNotas(oDocumentoWriter As Object, oTabla As Object, nNumeroColumnas%)

   Dim oRango As Object
   Dim sRango$
   
   sRango = "C1:" & CHR(65 + (nNumeroColumnas - 2)) & "2"
   
   oRango = oTabla.getCellRangeByName(sRango)
   oDocumentoWriter.CurrentController.Select(oRango)
   Distribute_Rows_Even_Like (oDocumentoWriter)
   
End Sub


Sub Distribute_Rows_Even_Like (oDocumentoWriter As Object)
rem ----------------------------------------------------------------------
rem define variables
   dim document   as object
   dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
   document   = oDocumentoWriter.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
   dispatcher.executeDispatch(document, ".uno:DistributeRows", "", 0, Array())
   dispatcher.executeDispatch(document, ".uno:GoToEndOfDoc", "", 0, Array())
   dispatcher.executeDispatch(document, ".uno:GoToEndOfDoc", "", 0, Array())

End Sub


PS. Рекомендую использовать как справочное пособие по работе с таблицами Writer.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
JohnSUN



Репутация: 0    

Зарегистрирован: 29.08.2011
Сообщения: 39
Откуда: Киев, Украина

СообщениеДобавлено: Ср Ноя 23, 2011 7:26 am    Заголовок сообщения: Ответить с цитатой

"de omnibus dubitandum - все подвергай сомнению" (с) Рене Декарт

В том смысле, что некоторые моменты в коде вызывают сомнения.
Например, первые же строчки
Код:
   Dim sMatriz()
   Redim sMatriz (i, j)

хочется переписать просто как
Код:
   Dim sMatriz(i, j)


А конструкции вида
Код:
   For i = ASC("C") To ((nNumeroColumnas - 4) + ASC("C"))
      oCelda = oTabla.getCellByName(CHR(i) & "2")

или
Код:
   For i = ASC("C") To ((nNumeroColumnas - 3) + ASC("C"))
...
      If ( (i - ASC("B")) < 10 ) Then

вообще повергают в изумление: почему ByName с кучей преобразований, а не просто ByPosition?
_________________
Владислав Орлов aka JohnSUN
LibreOffice 3.4.0 OOO340m1 (Build:12) WinXP SP2
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
neft



Репутация: 0    

Зарегистрирован: 19.10.2011
Сообщения: 28

СообщениеДобавлено: Ср Ноя 23, 2011 8:58 am    Заголовок сообщения: Ответить с цитатой

Синтаксические шероховатости есть, конечно.
Улучшение и доработка только приветствуются.

Но это не умаляет главного - пример полностью работоспособен и выполняет поставленную задачу.
Просто скопируй, вставь в свой документ и начинай модифицировать.

Есть много, что можно улучшить.
Например, таблица создается на всю ширину документа.
Как создать таблицу с ограниченной шириной?
Как её расположить по центру?
И т.д., и т.п.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic Часовой пояс: GMT
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group
Вы можете бесплатно создать форум на MyBB2.ru, RSS