アドバイスでできたマクロ「他ブックデータ取得」。何か不備あれば・・・ †
ページ | OpenOffice.org FAQの登録ページ |
---|---|
投稿者 | Mr_Happy |
分類 | |
優先順位 | |
状態 | |
カテゴリー | |
投稿日 | 2011-04-02 11:09:29 (土) |
OS | |
依存するページ | faq6/161,6/184,6/188,6/195 |
バージョン |
メッセージ †
回答ページでは行末に「~」を付加する必要はありません |
いつもお世話になります。本年2月からLibreOfficeのマクロに挑戦し始め、何度も質問し、とりあえずこれからの基礎となる私にとってのマクロの一分野が、ほぼ出来上がりました。皆さんのアドバイスのたまものです。 このマクロを見ていただき、更なるアドバイスがありましたらどしどしお願いします。 最初が肝心で、変な自己解釈があったりしてはまずい! との思いです。
内容は、他のファイル(Excel,Calc)にあるデータを読み込むこと。 次にそれを使用中のカルクやダイアログ中のリスト・ラベル・テキストなどに取り込み表示させることです。 これが出来れば、今後の応用が広がると考えていたわけです。
Option Explicit Private coDia1 As Object Sub Y_Dia1Show_Main() DialogLibraries.LoadLibrary("Standard") coDia1 = CreateUnoDialog(DialogLibraries.Standard.Dialog1) ' エクセルの絵本というファイルの2頁の B2-B6セルにあるデターを、リストに書き込む Y_SetList_Main("List1", "絵本.xlsx", 2, "B2:B6") Y_SetText_Main("Text1", "絵本.xlsx", 2, "D7") Y_SetLabel_Main("Label1", "絵本.xlsx", 2, "C6") coDia1.Execute coDia1.dispose End Sub 'sssss Listの初期値設定 sssssssssssssssssssssssssssssssssssssssssssssssss Sub Y_SetList_Main(sListNa, sYuBookNa, nYuPg, sYuRngAdr) Dim oYuCmp As Object Dim sLstDat(1) As Variant,nMx As Integer If Y_BookUMu(oYuCmp, sYuBookNa) = FALSE Then Exit Sub Call Y_GetListDat(oYuCmp, sYuRngAdr, nYuPg, nMx, sLstDat()) coDia1.getControl(sListNa).Model.Height = (nMx+1) * 10 coDia1.getControl(sListNa).Model.StringItemList = sLstDat() End Sub 'sssss Listに入れるデータ読込取得 sssssssssssssssssssssssssssssssssssss Sub Y_GetListDat(oYuCmp, sYuRngAdr, nYuPg, nMx, sLstDat()) Dim oYuRng As Object, oYuAdr As Object Dim nMyClm As Integer, nMyRow As Integer, n As Integer oYuRng = oYuCmp.Sheets(nYuPg).getCellRangeByName(sYuRngAdr) oYuAdr = oYuRng.getRangeAddress() nMyClm = oYuAdr.EndColumn - oYuAdr.StartColumn nMyRow = oYuAdr.EndRow - oYuAdr.StartRow nMx = nMyClm If nMyClm = 0 Then nMx = nMyRow ReDim sLstDat(nMx) For n=0 To nMx If nMyClm = 0 Then sLstDat(n) = oYuRng.getCellByPosition(0, n).String Else sLstDat(n) = oYuRng.getCellByPosition(n, 0).String End If Next End Sub '##### Lableの初期値設定############################################### Sub Y_SetText_Main(sTextNa, sYuBookNa, nYuPg, sYuCellAdr) Dim oYuCmp As Object, oYuCel Dim sTxtDat As Variant If Y_BookUMu(oYuCmp, sYuBookNa) = FALSE Then Exit Sub oYuCel = oYuCmp.Sheets(nYuPg).getCellRangeByName(sYuCellAdr) sTxtDat = oYuCel.getCellByPosition(0, 0).String coDia1.getControl(sTextNa).Text = sTxtDat End Sub '##### Lableの初期値設定 ############################################## Sub Y_SetLabel_Main(sLabelNa, sYuBookNa, nYuPg, sYuCellAdr) Dim oYuCmp As Object, oYuCel Dim sLblDat As Variant If Y_BookUMu(oYuCmp, sYuBookNa) = FALSE Then Exit Sub oYuCel = oYuCmp.Sheets(nYuPg).getCellRangeByName(sYuCellAdr) sLblDat = oYuCel.getCellByPosition(0, 0).String coDia1.getControl(sLabelNa).Text = sLblDat & "~" & chr$(13) End Sub 'sssss開いているDoc中から目的のDocを取得する sssssssssssssssssssssssss Function Y_BookUMu(oYuCmp, sYuBookNa) As Boolean Dim oComp As Object, oEnmr As Object Y_BookUMu = FALSE oComp = StarDesktop.getComponents oEnmr = oComp.CreateEnumeration() While oEnmr.hasMoreElements() oYuCmp = oEnmr.nextElement() IF oYuCmp.hasLocation Then ' Titleがあれば IF oYuCmp.Title = sYuBookNa Then ' ファイル名が一致すれば Y_BookUMu = TRUE Exit Function End IF End IF Wend Msgbox(sFileNa & " は開かれていません") End Function
以上です。よろしく吟味のほどを。
無題 †
tani (2011-04-04 09:55:30 (月))
特に問題ないと思いますが、あえてコメントすると、
・モジュールの先頭に「Option Explicit」(宣言していない変数が使えなくなるオプション)をつけてみては?
・開いている全ファイルのタイトルから目的のもの探し出すより、必要なファイルはマクロの中で開くようにしたほうが、応用性が高いのでは?
くらいが思いつきました。
無題 †
tani (2011-04-04 10:08:23 (月))
もう一点、↓はループ回数によってはとんでもなく時間がかかるかもしれませんので、getDataArrayメソッドとかを使うようにしたほうが良いかもしれません。For n=0 To nMx If nMyClm = 0 Then sLstDat(n) = oYuRng.getCellByPosition(0, n).String Else sLstDat(n) = oYuRng.getCellByPosition(n, 0).String End If Next
あっ、そうか getDataArray ですね †
Mr_Happy (2011-04-04 15:46:42 (月))
tani さん、ありがとうございます。まだほんの初心者なのでいいのか悪いのか、右も左もわからない状態なのでコメントをいただけると助かります。
>Option Explicit の宣言
これはしています。
>必要なファイルはマクロの中で開くようにしたほうが
開いているファイルでないと、という先入観がありました。
自分で開く分には、調べる必要もないということですよね。
>getDataArray
ループは遅くなる、とどこかで見ましたね。
この関数は一度扱いました。確か、一括して読み書きするときに使われたと。
ちょっと挑戦してみます。
getDataArray 2次元配列->1次元にするのかな †
Mr_Happy (2011-04-04 17:13:46 (月))
getDataArray を使ってデータを読むことや
setDataArray を使ってCalcのセルに書き込むことはできますが、
読み込んだデータは2次元配列で、そのままではリストに貼り付けることが
出来ません。
1次元の配列に直すこともできましたが、結局Forループを使う羽目に。
良い方法はあるのでしょうか?sYuDat = oYuRng.getDataArray() coDia.getControl(sListNa).Model.StringItemList = sYuDat()'エラー
PS ただし、読み込むデータは B2:B7 または B5:G5 のように縦方向のみまたは横方向のみとします。
無題 †
tani (2011-04-05 11:09:50 (火))
>1次元の配列に直すこともできましたが、結局Forループを使う羽目に。
↑で良いと思います。
同じ回数のループでも、そのなかでgetCellByPositionメソッドとか使っているのと、ただの配列操作しているのだったら、速度が段違いだったと思います。
ただまぁループ回数が数百件程度だったらそんなに気にする必要は無いと思います。(ひと桁多くなると大分差が出ると思います。)
無題 †
Mr_Happy (2011-04-06 12:32:15 (水))
taniさん、いろいろありがとうございます。
リストに一括して貼り付けはできないということでしょうか。
此処の部分は' 二次元配列を一次元配列に直す sDat = oBkRng.getDataArray() For n=0 To nSaMx If nClmSa = 0 Then sBkDat(n) = sDat(n)(0) Else sBkDat(n) = sDat(0)(n) End If Nextと、概ね上記のように改善したいと思います。
もう一つの課題、
>マクロの中で開くようにしたほうが
マクロが書かれたファイルと同じフォルダーに
読み込みたいファイルがある前提で、ファイル名の無い、
フォルダーまでのURLを得たいと思ったのですが、
適当な関数orメソッドが見当たりません。そこで次のようにしてみました。
Sub f_GetThisDocURL Dim oDocURL, sMyURL, i, buf() oDocURL = ThisComponent.getURL sMyURL = ConvertFromUrl(oDocURL) For i = Len(sMyURL) to 1 step -1 if Mid(sMyURL,i,1) = "\" then exit for next buf= Mid(sMyURL,1,i) msgbox buf End Sub
この後はこれから研究しますが、簡単に得る方法は無いのでしょうか?
無題 †
tani (2011-04-06 14:50:21 (水))
別の質問スレッドを立てたほうが良いと思いますが、sMyURL = ConvertFromURL(ThisComponent.getURL()) buf = Split(sMyURL, "\") MsgBox buf(Ubound(buf)) MsgBox Mid(sMyURL, 1, Len(sMyURL) - Len(buf(Ubound(buf))))こんな感じでいけます。
ありがとうございます。完了です †
Mr_Happy (2011-04-07 08:37:51 (木))
taniさん、本当にありがとうございます。
自分で消化できるよう若干アレンジをし、進化させました。
とりあえず完了にします。Option Explicit ##### D1_Dialog ダイアログの表示 ################################### Dim coDia As oject Sub y_D1DialogShow_Main() Dim oBkCmp As Object DialogLibraries.LoadLibrary("Standard") coDia = CreateUnoDialog(DialogLibraries.Standard.D1_Dialog) Call f_GetOpenCurCmp(oBkCmp, "絵本.xlsx") ' 絵本.xlsx を開く '------------- 読Book, 頁, 読Adr, Tool名, 種類 f_FSet_MyTool(oBkCmp, 2, "D7", "Text1", 0) f_FSet_MyTool(oBkCmp, 2, "C6", "Label1", 1) f_FSet_MyTool(oBkCmp, 2, "B2:F2","List1", 3) oBkCmp.Close(TRUE) coDia.Execute coDia.dispose End Sub sssss Toolの初期値設定 sssssssssssssssssssssssssssssssssssssssssss Sub f_FSet_MyTool(oBkCmp, nBkPgNo, sBkRngAdr, sToolNa, nTool) Dim oBkRng As Object, sBkDat() As Variant oBkRng = oBkCmp.Sheets(nBkPgNo).getCellRangeByName(sBkRngAdr) Select Case nTool Case 0,1: ' テキスト・ラベルなら sBkDat = oBkRng.getCellByPosition(0, 0).String If nTool = 1 Then sBkDat = sBkDat & "~" & chr$(13) coDia.getControl(sToolNa).Text = sBkDat Case 3: ' リストなら Call f_GetListDat(sToolNa, oBkRng, sBkRngAdr, nBkPgNo, sBkDat()) coDia.getControl(sToolNa).Model.StringItemList = sBkDat() End Select End Sub sssss Listに入れるデータ読込取得 ssssssssssssssssssssssssssssss Sub f_GetListDat(sToolNa, oBkRng, sBkRngAdr, nBkPgNo, sBkDat()) Dim oBkAdr As Object, sDat() As Variant Dim nClmSa As Integer, nRowSa As Integer Dim nSaMx As Integer, n As Integer oBkAdr = oBkRng.getRangeAddress() nClmSa = oBkAdr.EndColumn - oBkAdr.StartColumn nRowSa = oBkAdr.EndRow - oBkAdr.StartRow nSaMx = nClmSa If nClmSa = 0 Then nSaMx = nRowSa ReDim sBkDat(nSaMx) coDia.getControl(sToolNa).Model.Height = (nSaMx+1) * 10' 高さ調整 sDat = oBkRng.getDataArray() For n=0 To nSaMx If nClmSa = 0 Then sBkDat(n) = sDat(n)(0) ' 配列変更 Else sBkDat(n) = sDat(0)(n) End If Next End Sub #####使用ファイルのカレントURLから他のファイルを開く ########### Sub f_GetOpenCurCmp(oBkCmp, sBkName) Dim sCnvURL As Variant, sCurURL As String, sBkURL As String Dim Dummy(), sBuf As Variant, i As Integer sCnvURL = ConvertFromUrl(ThisComponent.URL) sBuf = Split(sCnvURL, "\") For i=0 To Ubound(sBuf)-1 sCurURL = sCurURL & sBuf(i) & "\" Next sCurURL = sCurURL & sBkName sBkURL = ConvertToUrl(sCurURL) oBkCmp = StarDesktop.loadComponentFromURL(sBkURL, "_default", 0, Dummy()) 'msgbox sCurURL End Sub完了しますが、更に何かのアドバイスがありましたら、お願いします。