Top > OOobbs2 > 32

OOobbs2/32 Edit

  • サマリ: 文字の均等割付マクロ
  • 環境: Writer
  • 状態: 投稿
  • 投稿者: sato?
  • 投稿日: 2007-03-13 (火) 15:55:23

質問 Edit

Writerで文字の均等割り付けを行なうマクロを作成してみました。使い方は、MSWordの文字の均等割り付けのダイアログボックスと同じようなものを作成し、「文字数を入力する部分」と「OK」、「キャンセル」、「解除」ボタンを作成しそれぞれに、kousin,ok,closedialog,Kaizyo を登録し、使用します。

REM  *****  BASIC  *****

' 「均等割付」マクロです。
'ツールバー ・・・・ 「書式設定」に登録して使用すると便 利です。
'MSWordの均等割付のダイアログボックスと同じ様なものを作成してください。
'(図形描画のテキストには使用できませんエラーを起こします。)


dim oDlg as object
dim oMozihaba as object '割り付け文字数
dim oHani as object '選択範囲
dim mMozisu as single '選択範囲の実幅(文字カウント)
dim mZisu as integer '選択範囲字数
dim mHyoPH as integer '標準文字ポイント(文字ポイント*35)
dim oWritukesu as single '割り付け字数
dim oWritukepo as single '割り付けポイント
dim mZenH as integer '全幅数(ポイント数*35で取得)
dim mZiH as single '全文字幅数(ポイント数*35で取得)


sub Kinto   'ダイアログのオープン
On Error goto ErrHandler
	DialogLibraries.LoadLibrary("Standard")
	oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
	TextHani
	HyoziMS
	TextHani '範囲を元に戻すため「hani」を実行
	if mZisu > 1 then
		oMozihaba = oDlg.getcontrol("Mozihaba")
		oMozihaba.text = mMozisu
		oWritukesu = oMozihaba.text
		oDlg.Execute()
	else
		msgbox "文字を選択してください"
	end if
Exit Sub
ErrHandler:
	Msgbox "範囲を正しく指定してください"		
end sub

sub kousin '割り付け字数を変えたとき
	oMozihaba = oDlg.getcontrol("Mozihaba")
	oWritukesu = oMozihaba.text
end sub


sub closedialog   'ダイアログのクローズ 「キャンセル」
	oDlg.endexecute()
end sub

sub TextHani     '範囲の取得
	dim oDoc as object
	dim oView as object
	oDoc = thiscomponent
	oView = odoc.getcurrentcontroller().getviewcursor ()'ドラッグした範囲をオブジェクトとして取得	
	oText =oView.gettext()
	oHani = otext.createtextcursorbyrange(oView) 'ドラッグした範囲のテキストカーソルを取得
end sub
'文字間隔を広げる(指定した部分より一文字少なく文字間隔を広げる) 「OK」
sub Warituke
	dim oWTST as integer
	oWTST = oWritukesu * mHyoPH
	
	if oWTST>mZiH then
		if mZisu <=1 then
			Kaizyo
		else
			oWritukepo = (oWTST-mZiH)/(mZisu-1) '文字間隔をあわせるための計算
			oHani.goleft(mZisu,false)
			oHani.goright((mZisu-1),true)
		end if				
		oHani.charkerning = oWritukepo
	else
			Kaizyo
	end if
	oDlg.endexecute() '動作終了後のダイアログボックスのクローズ
end sub
'文字間隔を標準にする 「解除」
sub Kaizyo
	oHani.charkerning = 0
	oDlg.endexecute()	
end sub
Sub HyoPo'標準文字サイズを取得(段落スタイルで文字設定になっている)
Dim oDoc As Object, oStyleFamilies As Object
Dim mHmozipo as integer
Dim oParagraphStyles As Object, oParagraphStyle As Object
 oDoc = ThisComponent
 oStyleFamilies = oDoc.StyleFamilies
 oParagraphStyles = oStyleFamilies.getByName("ParagraphStyles")
 oParagraphStyle = oParagraphStyles.getByName("標準")
 mHmozipo = oParagraphStyle.CharHeightAsian
 mHyoPH = mHmozipo*35
End Sub
'文字数の計算(均等割付しようとしたときに表示する文字数)
sub HyoziMS
	dim oString as string  '文字を取得
	dim mKanH as single '全文字間幅数(ポイント数*35で取得)
	dim mKanHs as single '文字間幅数(ポイント数*35で取得)
	dim mMozi as single '文字ポイント取得
	dim mZiHs as single '文字幅数(ポイント数*35で取得)
	dim i as single '計算回数のための変数
	
	HyoPo		
	oString = oHani.getstring()
	mZisu = len(oString)'文字数
	mZikazu=0
		if mZisu > 1 then
			oHani.goleft(mZisu,false)
			
			for i = 1 to mZisu
				oHani.goright( 1 , false)
				mKanHs = oHani.charkerning
				mMozi = oHani.charheightasian
				mZiHs = mMozi*35
				mKanH = mKanH + mKanHs
				mZiH = mZiH + mZiHs
			next
			mZenH = mKanH + mZiH
			mZikazu = (mKanH + mZiH)/mHyoPH	
		endif
		mMozisu = int(mZikazu*100)/100
end sub

回答 Edit


感想,コメント,メモ Edit

  • satoさんの文字の均等割付マクロにダイアログをつけ、エクステンションにしてみました。2.1、2.2で動作を確認しました。
    2.1以降なら ファイルのダブルクリックでインストール可能なはずですが、「ツール」−「拡張機能マネージャ」でもインストールできます。
    その後、添付の ファイルを読み込むと、「書式」−「文字の均等割付」メニューが機能します。文字列を選んで、「新しい文字列の幅」欄の値を増やして「OK」ボタンをクリックすると選んだ部分の文字列が均等割付されます。 -- M.Kamataki 2007-06-22 (金) 21:35:28
  • satoさんにお願いがあります。もし、当ページをお読みになられたら、文字の均等割付マクロのライセンスをGPLとすることに同意していただけますでしょうか。Readme.txtとGPLを同梱した形で、適切なサイトからダウンロードできるようにしたいと考えています。 -- M.Kamataki 2007-06-22 (金) 21:42:59
  • JapaneseJustify.oxtのMD5値は、MLへ投稿した以下のページで確認できます。
    http://www.freeml.com/message/openoffice@freeml.com/0010507 -- M.Kamataki 2007-06-22 (金) 22:43:45
  • いつもお世話になっています。皆さんが便利に使えるようになることを目的で投稿したので、皆さんが使えるようになるのであればGPLに同意します。なお、アイコンに登録できるようになればもっと便利になると思いますので、この点も宜しくお願いします。 -- sato? 2007-06-26 (火) 13:03:25
  • 追伸、このマクロには「はにぁ?」さんに教えていただいたマクロも記述してあります。 -- sato? 2007-06-26 (火) 13:16:23
  • 一応、私のほうは自由にお使いください。 -- はにゃ?? 2007-06-26 (火) 21:55:51
  • satoさん、はにゃ?さん、ありがとうございます。エクステンションの集約場所として http://sourceforge.jp/projects/openoffice-docj を想定しています。また、報告します。 -- M.Kamataki 2007-06-27 (水) 10:08:35
  • http://www.freeml.com/openoffice/10574 に「文字の均等割付」エクステンションなどを紹介したOSC2007 Hokkaidoでのセミナー資料を公開した旨、報告しました。よろしければご覧になってください。 -- M.Kamataki 2007-07-11 (水) 22:17:02
  • http://kyankyan.net/?p=3680 でLibreOffice 4以降で動かないという情報がありましたが、マクロのうち「"標準"」を「"Standard"」に変更すれば、動きます。 -- M.Kamataki 2014-03-22 (土) 17:39:01
  • 今日のOSC浜名湖でコードを検証し、無難な英語にしてみて、動作を確認しました。 -- M.Kamataki 2014-03-22 (土) 17:41:38
  • 本日 を更新しました。選択した範囲の段落スタイルを取得してから均等割り付けの処理をするように変更したので、上記の「LibreOffice 4以降で動かない」という問題にも対処しています。ツールメニューから実行できるようにしたので、文字列を選択してから[ツール]-[アドオン]-[文字の均等割り付け]をクリックしてください。 -- M.Kamataki 2014-04-13 (日) 16:46:31


Attach file: fileJapaneseJustify.oxt 1161 download [Information] file均等割付サンプルテキスト.odt 1233 download [Information]

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