faq/6/196

　ｱﾄﾞﾊﾞｲｽでできたマクロ「他ブックデータ取得」。何か不備あれば・・・ †

メッセージ †

いつもお世話になります。本年２月からLibreOfficeのマクロに挑戦し始め、何度も質問し、とりあえずこれからの基礎となる私にとってのマクロの一分野が、ほぼ出来上がりました。皆さんのアドバイスのたまものです。 このマクロを見ていただき、更なるアドバイスがありましたらどしどしお願いします。 最初が肝心で、変な自己解釈があったりしてはまずい！　との思いです。

内容は、他のファイル（Excel,Calc）にあるデータを読み込むこと。 次にそれを使用中のカルクやダイアログ中のリスト・ラベル・テキストなどに取り込み表示させることです。 これが出来れば、今後の応用が広がると考えていたわけです。

Option Explicit 
Private coDia1 As Object
Sub Y_Dia1Show_Main()                                        
  
   DialogLibraries.LoadLibrary("Standard")
   coDia1 = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
   ' ｴｸｾﾙの絵本というﾌｧｲﾙの２頁の 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 Ｌｉｓｔの初期値設定　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 Ｌｉｓｔに入れるデータ読込取得　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
'##### Ｌａｂｌｅの初期値設定###############################################
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
'##### Ｌａｂｌｅの初期値設定 ##############################################
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開いているＤｏｃ中から目的のＤｏｃを取得する  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 ２次元配列->１次元にするのかな †

Mr_Happy (2011-04-04 17:13:46 (月))

getDataArray を使ってデータを読むことや
setDataArray を使ってCalcのセルに書き込むことはできますが、
読み込んだデータは２次元配列で、そのままではリストに貼り付けることが
出来ません。
１次元の配列に直すこともできましたが、結局Forループを使う羽目に。

良い方法はあるのでしょうか？

sYuDat = oYuRng.getDataArray()
coDia.getControl(sListNa).Model.StringItemList = sYuDat()'ｴﾗｰ

PS ただし、読み込むデータは B2:B7 または B5:G5 のように縦方向のみまたは横方向のみとします。

無題 †

tani (2011-04-05 11:09:50 (火))

＞１次元の配列に直すこともできましたが、結局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 Ｌｉｓｔに入れるデータ読込取得　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
#####使用ファイルのカレントＵＲLから他のファイルを開く　###########
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

完了しますが、更に何かのアドバイスがありましたら、お願いします。

お名前:
題名: