faq/6/184

他Bookのセル読み込み　これは何なんでしょう！？ †

ページ	OpenOffice.org FAQの登録ページ
投稿者	Mr_Happy
分類	Q&A要望不具合メンテナンス
優先順位	緊急重要普通低
状態	質問回答中完了完了回答待ち議論中Issues重複却下保留再現不可
カテゴリー	インストール全体Writer ワープロCalc 表計算Impress プレゼンテーションDraw 図形描画Base データベースHTMLエディタMath 数式エディタLinux版StarSuiteその他
投稿日	2011-03-21 11:06:10 (月)
OS	Win7
依存するページ	•faq/6/188
バージョン	3.4.53.4.43.4.33.4.23.4.13.4.03.3.53.3.43.3.33.3.23.3.13.3.03.2.13.2.03.1.13.1.03.0.13.0.02.4.32.4.22.4.12.42.3.12.32.2.12.22.12.0.42.0.32.0.22.0.12.01.1.51.1.41.1.31.1.21.11.0.31.0.21.0.11.0Dev3.3Dev3.2Dev3.1Dev3.0不明

メッセージ †

お世話になります。 小生なんとかして簡単に他のCalcブックのセルを読み込めないかと苦戦中。 先日、エクセルのＶＢＡをＩＤＥに移植できないか、とやっているうちに 下記のように書くとうまく動作したのです！！ ところが、そうこうするうちにエラーとなりできなくなります。 もう一度立ち上げなおしたとき、動作するときもあるのです！ 原因が全くつかめません。 たぶんもともと無理な構文なのでしょうが、 「うまくゆくときがある」 ということに未練があり、皆さんのアドバイス等ご意見を聞かせていただきたいと思います。

下記はその時のマクロで、二つは同じものです。

Sub MacroX1()
 Dim aa as String 
 aa = Workbooks("絵本.xlsx").Sheets(1).Range("D7")
 ThisComponent.Sheets(0).getCellByPosition(5,3).String=aa  
End Sub

Sub MacroX2()
 Dim aa as String
 Workbooks("絵本.xlsx").Activate 　 ' 左記二行がエクセル流の書式で、他のファイルを読み込む
 aa = Sheets(1).Range("D7")   　　  ' 最初のシートのＤ７セルを代入
     
 ThisComponent.Sheets(0).getCellByPosition(5,3).String=aa   ' マクロのあるodsファイルに書き込み
End Sub

追記 †

Mr_Happy (2011-03-21 11:22:21 (月))

「絵本.xlsx」はエクセルではなく、LibreOfficeで開いた状態です。 もちろん他のＯＤＳファイルも同様に読み込みを目指します

追記の追記 †

Mr_Happy (2011-03-21 16:42:03 (月))

このマクロを書いたModule1の先頭は

REM ***** BASIC *****　ですが

Sheet1 のマクロ頁の先頭では

Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1

となってますが、関係はあるのでしょうか？

ちなみに他のodsファイルにマクロを移植すると、うまくゆくときは無いようです。

またＶＢＡ属性の設定ダイアログでは、エクセルのバージョンが
97/2000/XP でWin7が書かれていません、この辺はどうなのかな？

どなたか教えてくださーい！

VBA互換モード †

ike@九州 (2011-03-22 10:12:30 (火))

Option VBASupport 1 を記述すると
OOo Basic はVBA互換モードで動作します。
VBA形式で記述されたコードをある程度通訳して動作させるという仕様です。

別のソフトウェアですので完全互換ではなくある程度の動作になります。
以下のサイトが詳しく解説されています。
http://freeopenoffice.jimdo.com/

但し、出来るならば VBA互換モードを使用する事なく別個に勉強されたほうが後々、スムーズに行くので宜しいかと…

以下は OOoBasic オンリーです
ThisComponent はアクティブなコンポーネントを取得しますので、絵本.xlsx がアクティブになっていると oDoc も絵本.xls になり正しく動作しないので書き込みたいドキュメントをクリックするなりしてアクティブにして次にマクロを実行する必要があります。
（"絵本.xlsx" は既に開いているものとしています）

Sub test
 oDoc = ThisComponent 
 oDoc2 = fnGetComponentByName("絵本.xlsx")
 IF IsNull(oDoc2) Then
 　Msgbox("指定されたドキュメントは開かれていません")
   Exit Sub
 End IF
 oDoc.Sheets(0).getCellByPosition(5,3).String = oDoc2.Sheets(0).getCellRangeByName("D7").String
End Sub

'開いているドキュメントの中から取得する
Function fnGetComponentByName(filename As string) As Object
  oComponents = StarDesktop.getComponents
  oEnum = oComponents.createEnumeration()
  While oEnum.hasMoreElements()
    oComponent = oEnum.nextElement()
    IF oComponent.haslocation then
       IF Dir(oComponent.location) = fileName Then
          fnGetComponentByName = oComponent
          Exit Function
       End IF
    End IF   
  Wend
  fnGetComponentByName = Nothing
End Function

ありがとうございます。完了です †

Mr_Happy (2011-03-22 10:52:21 (火))

ike@九州 さんありがとうございます

VBA形式で記述されたコードをある程度通訳して動作させるという仕様です。

別のソフトウェアですので完全互換ではなくある程度の動作になります。

やはりそうですよね。出来れば　OOoBasic オンリーでゆきたいわけです。
今テストしてみて、うまく書き込みできるのでさらに挑戦する気になってきました。
ＶＢＡとは勝手が違い戸惑うばかりですが、お陰様で折れずにすみました。

VBA --> OOo.Basic 移植 †

K.Tsunoda (2011-03-22 13:40:11 (火))

＞ ＶＢＡとは勝手が違い戸惑うばかりです
今までの移植作業で、ぶつかった壁＆回避策です。下記参考に

「VBA vs OOo.Basic 対比表」
http://www.h3.dion.ne.jp/~sakatsu/OOo_vs_VBA.htm

「VBAユーザーの為のOpenOffice.org 備忘録」
http://blog.livedoor.jp/addinbox/

こんなのができました †

Mr_Happy (2011-03-28 12:50:08 (月))

お陰様で下記のようなプログラムが出来ました。
もしもこれを見かけて手直ししたほうが良い場合は、そのアドバイスをお願いします。完了したけど、せっかく苦労したので・・・

'今使用しているＣａｌｃの０頁のＣ３〜Ｆ７セルに、
'開いている「絵本.xlsx」の２頁のＢ２〜のデータを書き込む
Sub Y_DocYomiKaki_Main
   Y_DocYomiKaki(0,"C3:F7","絵本.xlsx",2,"B2")
End Sub

Sub Y_DocYomiKaki(nMyPg, sMyRngAdr, sYuBkNa, nYuPg, sYuCellAdr)
   Dim oMyCmp As Object, oMyDoc As Object
   Dim oYuCmp As Object, oYuDoc2 As Object
   Dim oYuSht As Object, oYuDat As Object
   Dim nMxClm As Integer, nMxRow As Integer
   
   oMyCmp = ThisComponent                       
   oMyDoc = oMyCmp.Sheets(nMyPg).getCellRangeByName(sMyRngAdr) 
　' 使用中のドギュメント
   Call Y_GetMyAdr(oMyDoc, nMxClm, nMxRow)　　                 
　' 貼り付け場所の範囲を得る
          
   If Y_ChkYuCmp(oYuCmp, sYuBkNa) = FALSE Then Exit Sub　　　　
　' 目的のファイルがなければ終了
   oYuSht = oYuCmp.Sheets(nYuPg)　　　　　　　　　　　　　　　'
   oYuDoc2 = oYuSht.getCellRangeByName(sYuCellAdr)            
  ' 目的ファイルの最初のセルのあるドギュメント
   Call Y_GetYuDat(oYuSht, oYuDoc2, oYuDat, nMxClm, nMxRow)　　
　' 目的ファイルからデータを得る
   oMyDoc.setDataArray(oYuDat)                                 
　' 使用中のファイルにデータを書き込む
End Sub

Sub Y_GetMyAdr(oMyDoc, nMxClm, nMxRow)
   Dim oMyAdr As Object
   
   oMyAdr = oMyDoc.getRangeAddress()
   nMxClm = oMyAdr.EndColumn - oMyAdr.StartColumn
   nMxRow = oMyAdr.EndRow - oMyAdr.StartRow
End Sub

Sub Y_GetYuDat(oYuSht, oYuDoc2, oYuDat, nMxClm, nMxRow)
   Dim oYuDocNew As Object, oYuAdr As Object   
  
   oYuAdr = oYuDoc2.getCellAddress()
   oYuDocNew = oYuSht.getCellRangeByPositi( _
               oYuAdr.Column,oYuAdr.Row, _
               oYuAdr.Column + nMxClm, oYuAdr.Row + nMxRow)
   oYuDat = oYuDocNew.getDataArray()
End Sub 
'sssss開いているＤｏｃ中から目的のＤｏｃを取得する  sssssssss
Function Y_ChkYuCmp(oYuCmp As Object,sFileNa As String) As Boolean
   Dim oComp As Object, oEnmr As Object
   
   oComp = StarDesktop.getComponents
   oEnmr = oComp.CreateEnumeration() 
   While oEnmr.hasMoreElements()
       oYuCmp = oEnmr.nextElement()
       IF oYuCmp.hasLocation Then                         
       ' Titleがあれば        
           IF oYuCmp.Title = sFileNa Then                 
            ' ファイル名が一致すれば    
              Y_ChkYuCmp = TRUE　　   　               
              Exit Function
           End IF
       End IF
   Wend
   Y_ChkYuCmp = FALSE
   Msgbox(sFileNa & " は開かれていません")
End Function

何で？ †

Mr_Happy (2011-03-28 12:53:45 (月))

何で　Sub・・・やEnd Sub の部分などが灰色の枠からはみ出るのでしょうかね・・・・
書き方がわかりません！！　Ｈｅｌｐｅ

Re: 何で？ †

M.Kamataki (2011-03-28 13:38:04 (月))

行頭に半角スペースを入れると、整形済みテキストになります。（直しておきました）

左のメニューから「当サイトの使い方」-「PukiWikiの編集方法」-「テキスト整形のルール」をご覧ください。