Free版Office LibreOffice Basic TextBox Shapeの文字変更とフォントサイズ変更


年賀状宛名印刷に向けて処理内容のロジック確認を含めて
ソースコードを作っていきます。(テストの意味もありますが)

ハガキ印刷の宛名のをテキストshapeにして縦書きや位置調整を行うため テキストShapeに対する処理の確認です


Sub Main ''//関数の宣言
Dim oDrawPages As Object ''//変数宣言
Dim oDrawPage As Object   ''//変数宣言

''//シート(Sheet2)内の図形配列を取得する
oDrawPages = ThisComponent.Sheets.getByName("Sheet2").DrawPage
''//サブ関数を使って名前が一致するテキストボックスオブジェクトを取得する
getTextShapeByName(oDrawPage,oDrawPages,"TextName01")
''//取得したTEXTBOXにテキストを入力する
oDrawPage.String="東京 太郎"
''//取得したTEXTBOXの日本語フォントサイズを設定する
oDrawPage.Text.CharHeightAsian=25
''//取得したTEXTBOXの英文フォントサイズを設定する
oDrawPage.Text.CharHeight=25

getTextShapeByName(oDrawPage,oDrawPages,"TextName02")
''oDrawPage=oDrawPages(3)
oDrawPage.String="大阪 次郎"
oDrawPage.Text.CharHeightAsian=30
oDrawPage.Text.CharHeight=30

End Sub
''//---------------------------------------------------------------
''//名前でTextShapeオブジェクトを検索する関数
''//---------------------------------------------------------------
Sub getTextShapeByName(TextShape as object,arrTextShape as object,cName as String)
Dim i as Integer

For i = 0 To arrTextShape.Count - 1
	If arrTextShape.GetbyIndex(i).Name=cName Then
    	TextShape =  arrTextShape.GetbyIndex(i)
    	Exit Sub
  	End If
Next i

end sub

現在行を取得して名前データのセルの値を取得しテキストShapeに入力してみます


Sub Main
Dim oDrawPages As Object
Dim oDrawPage As Object
dim sh as Object
dim oCcell as object
dim ocell as object
dim strName1 as string
dim strName2 as string
dim strName3 as string
dim strName4 as string
dim strName5 as string
dim LnameCnt as Integer
dim strNameAll as String

''//シートオブジェクトを取得する
sh=ThisComponent.Sheets.getByName("Sheet1")
''//TextBoxオブジェクトを取得する
oDrawPages = sh.DrawPage
getTextShapeByName(oDrawPage,oDrawPages,"TextNameS101")

''//カーソルのあるセルを取得する
oCcell = ThisComponent.getCurrentSelection()

’’//カーソルのあるセルと同じ行の名前データを取得する
ocell=sh.getCellByPosition(1,oCcell.CellAddress.row)
strName1=ocell.String & " "
ocell=sh.getCellByPosition(2,oCcell.CellAddress.row)
strName2=ocell.String
ocell=sh.getCellByPosition(3,oCcell.CellAddress.row)
strName3=ocell.String
ocell=sh.getCellByPosition(4,oCcell.CellAddress.row)
strName4=ocell.String
ocell=sh.getCellByPosition(5,oCcell.CellAddress.row)

''//全角スペースと敬称
strName5=" " & ocell.String 

''姓の文字数
LnameCnt=Len(strName1)

''//名前1の姓名をセットする
strNameAll=strName1 & strName2  & strName5
''//名前2がスペースじゃなければ名前2の姓(全角スペース)+名をセットする
IF strName3<>"" THEN
strNameAll =strNameAll  & chr(13) & String(LnameCnt," ") & strName3 & strName5
ENDIF
''//名前3がスペースじゃなければ名前3の姓(全角スペース)+名をセットする
IF strName4 <>"" THEN
strNameAll =strNameAll  & chr(13) & String(LnameCnt," ") & strName4 & strName5
ENDIF
oDrawPage.String=strNameAll
''//oDrawPage.Text.CharHeightAsian=25
''//oDrawPage.Text.CharHeight=25


End Sub

''//---------------------------------------------------------------
''//名前でTextShapeオブジェクトを検索する関数
''//---------------------------------------------------------------
Sub getTextShapeByName(TextShape as object,arrTextShape as object,cName as String)
Dim i as Integer

For i = 0 To arrTextShape.Count - 1
	If arrTextShape.GetbyIndex(i).Name=cName Then
    	TextShape =  arrTextShape.GetbyIndex(i)
    	Exit Sub
  	End If
Next i

end sub


コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です