Top > OOobbs3 > 22
** [[OOobbs3/22]] [#z22413b8]
-''サマリ'': WriterにおけるOutline設定について
-''環境'': Writer
-''状態'': 解決
-''投稿者'': [[new_OOo3]]
-''投稿日'': 2010-09-26 (日) 14:50:58
*** 質問 [#e4f60e1c]
お世話になります。

以前に「 [[OOobbs3/18]] 」にてご教示頂きましたmacroでのImpressのOutline設定方法とNet検索結果を基に、WriterでもOutlineを設定をするべく下記Codeを作成しましたが、Outline設定ができません。

 ******** Code( Outline設定 in Writer ) ************
 Sub oOutlineInWrite
  	Dim oDoc
  	Dim oDText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	'
  	Dim oRules
  	Dim oRule()
  	Dim oProp
  	Dim oNames(0)
  		oNames(0) = "_New_Heading_1"
  		oRules = oDoc.getChapterNumberingRules()
  		For i = 0 To UBound(oNames())
    		If i >= oRules.getCount() Then Exit Sub
    		oRule() = oRules.getByIndex(i)
    		For j = LBound(oRule()) To Ubound(oRule())
      			oProp = oRule(j)
      			Select Case oProp.Name
      				Case "HeadingStyleName"
        				oProp.Value = oNames(i)
      				Case "NumberingType"
        				oProp.Value = com.sun.star.style.NumberingType.ARABIC
      				Case "ParentNumbering"
        				oProp.Value = i + 1
      				Case "Prefix"
        				oProp.Value = ""
      				Case "Suffix"
        				oProp.Value = " " 
      			End Select
      			oRule(j) = oProp
    		Next j
    		oRules.replaceByIndex(i, oRule())
  		Next i	
  		'
  	Dim oFamilies
  	Dim oParaStyles
  	Dim oStyle
  		oFamilies = oDoc.StyleFamilies
  		oParaStyles = oFamilies.getByName("ParagraphStyles")
  		'
    	oStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")
    	oStyle.setParentStyle("Heading")
    	'
    	oStyle.CharHeight = 20
    	oParaStyles.insertByName(oNames(0), oStyle)
    '	
    	oDText = oDoc.getText()
			oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
				"This line is second paragraph. It is third line." & Chr$(13) & _
				"This line is third  paragraph. It is fourth line." & Chr$(13) & _
				"This line is fourth  paragraph. It is fifth line."
			oDText.insertString(oDText.getEnd(), oDisp, true)
 End Sub
 ************************************************

 [ Macro実行結果 ](質問後の追記)
 This line is first paragraph. This is first line.
 This line is second paragraph. It is third line.
 This line is third  paragraph. It is fourth line.
 This line is fourth  paragraph. It is fifth line.


しかし本来は下記Macro実行結果を得たいと考えております。

[アラビア数字を用いたOutline(箇条書き)]

 [ Macro実行結果 ]
 1 This line is first paragraph. This is first line.
 2 This line is second paragraph. It is third line.
 3 This line is third  paragraph. It is fourth line.
 4 This line is fourth  paragraph. It is fifth line.


同じような質問で恐縮ですが宜しくご教示頂けます様お願いします。
*** 回答 [#ye85ea0b]
- どうできないのか書いてもらえると助かりますが・・・。アウトライン番号は段落ごとになります、そのため各段落ごとに挿入するほうが分かり易いと思います。ほとんどは[[OOoBasic/Writer/NumberingStyle]]参照。

 Sub InsertOrderedParagraphs
  oDoc = ThisComponent
  oText = oDoc.getText()
  oCursor = nothing
  
  ' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
  oRule = nothing
  oRules = oDoc.getNumberingRules()
  For i = 0 To oRules.getCount() - 1 step 1
    If oRules.getByIndex(i).Name = "Outline" Then
      oRule = oRules.getByIndex(i)
      Exit For
    End If
  Next
  If IsNull(oRule) Then Exit sub
  
  ' 番号付けスタイルの表示形式を変更
  ' change numbering type
  For i = 0 To oRule.getCount() - 1 step 1
    oLevel = oRule.getByIndex(i)
    n = FindItemIndex(oLevel, "NumberingType")
    If n >= 0 Then
      oItem = oLevel(n)
      If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
        oItem.Value = com.sun.star.style.NumberingType.ARABIC
        oLevel(n) = oItem
        oRule.replaceByIndex(i, oLevel)
      End If
    End If
  Next
  
  ' 段落の挿入と段落に番号付けを設定
  sLines = Array("1st", "2nd", "3rd")
  
  For i = 0 To UBound(sLines) step 1
    oPara = oText.appendParagraph(Array())
    oCursor = oText.createTextCursorByRange(oPara)
    oText.insertString(oCursor, sLines(i), False)
    
    oCursor.ParaStyleName = "Heading 1"
    oCursor.NumberingRules = oRule
  Next
 End Sub
 
 
 Function FindItemIndex(aProps As Object, sName As String) As Integer
 Dim nFound As Integer
 nFound = -1
 For i = 0 To UBound(aProps) step 1
   If aProps(i).Name = sName Then
     nFound = i
     Exit For
   End If
 Next
 FindItemIndex = nFound
 End Function


-- はにゃ? &new{2010-09-26 (日) 18:08:58};
- ご教示ありがとうございました。上手く出来ました。 -- new_OOo3 &new{2010-09-29 (水) 21:44:54};

質問中のCodeでの結果を上記質問中に追記させて頂きました。

また、ご教示頂きました内容を反映したcodeを参考までに以下に記します。

 ********** 正解 Code *************
 Sub oOutlineParagraph
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 
 		' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' 番号付けスタイルの表示形式を変更
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.ARABIC
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
 End Sub
 '
 '[ Function 1 ]
 Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
 End Function
 ****************************************************************

[ Macro実行結果 ]

1 This line is first paragraph. This is first line.

2 This line is second paragraph. It is third line.

3 This line is third  paragraph. It is fourth line.

4 This line is fourth  paragraph. It is fifth line.




#comment
*** 感想,コメント,メモ [#o9d60416]

#comment

Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup   Help   RSS of recent changes