別のodsファイルに書き込む方法が分からない

masahiro · March 4, 2024, 9:36am

お世話になります。
先日投稿させていただいた、「basicにパスワードを掛けるとvba support 1が無効化される」に関連の投稿です。

vba support 1が無効化されるのはバグのようなので早々に改善されるとは思えず、いったんこのオプション無しでコードを書きたいのですが問題があります。

別のodsファイルを指定してセルに書き込む構文が分からないのです。
下記の構文では別ファイルが指定できず困っています。
ThisComponent.Sheets(0).getCellByPosition(0,0).String

また四捨五入に関してもネットで探してもピッタリな情報が見つからず、、、

私の探し方が悪いのかもしれません。ご協力お願いいたします。

sabr0 · March 5, 2024, 8:17am

別ファイルとのやりとりは私はつまづいてましたので
コメントできませんが参考サイトを載せときます。
StarDesktopを使うみたいです。
LibreOffice Calc Basic fun!!!:ドキュメント操作

Roundに関して

Function MyRound(ByVal nNumber As Double, Optional ByVal nKeta As Integer) As Double
	If IsMissing(nKeta) = True Then
		nKeta = 0
	End If
	MyRound = Int((nNumber * 10^(nKeta + 1) + 5 ) / 10) / 10^(nKeta)
End Function

シート関数を呼び出して使うこともできるみたいです。

Function UsefARound(ByVal nNumber As Double, Optional ByVal nKeta As Integer) As Double
	If IsMissing(nKeta) = True Then nKeta = 0
	If IsNull(fA) Then fA = CreateUnoService("com.sun.star.sheet.FunctionAccess")
	UsefARound = fA.CallFunction("ROUND", Array(nNumber, nKeta))
End Function

sabr0 · March 6, 2024, 8:07am

ScriptForgeを使う方法もある（私がやりたいことはこっちでできそう）
https://help.libreoffice.org/latest/ja/text/sbasic/shared/03/sf_calc.html

hidemune · March 7, 2024, 11:45am

０．５を足して、小数点以下切り捨てると四捨五入できます。

masahiro · April 5, 2024, 1:03am

ご協力ありがとうございます。どうにか解決いたしました。
他のファイルに書き込むのは以下のコードを使用しました。

' 書き込みたいファイルの名前を指定します。
sDocName = "他のファイル.ods"

' 開いているすべてのドキュメントを取得します。
Dim oDocs As Object
oDocs = StarDesktop.getComponents().createEnumeration()

' 開いているドキュメントの中から指定した名前のドキュメントを探します。
Do While oDocs.hasMoreElements()
    oDoc = oDocs.nextElement()
    If oDoc.getTitle() = sDocName Then
        Exit Do
    End If
Loop

' シートを取得します。
oSheet = oDoc.Sheets.getByName("シート名")

' セルに値を設定します。
oSheet.getCellByPosition(0,0).setValue("test")

四捨五入及び小数点以下の桁数固定は以下のコードで実現できました。

format(11.5,"#0.000") //11.500

皆様改めてご協力ありがとうございました。

sabr0 · March 10, 2024, 9:53am

それなりに動くものができたのでコードを載せます
ファイルAから
ファイル選択ダイアログでファイルBを選択し、
ファイルBを非表示で開き、
ファイルBのシート1の最後の行の次の行にファイルAのシート1のA1の文字を書き写すというマクロ

Sub otherODSfile
  Dim oFP As Object
  Dim sFileURL As String
  Dim oRes As Object
  Dim oDocA As Object, oDocB As Object
  Dim oDocBSheet As Object
  Dim oDocBCur As Object
  Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
  Dim nRow As Long
  oDocA = Thiscomponent
  oRes = com.sun.star.ui.dialogs.ExecutableDialogResults
  oFP=CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
  oFP.appendFilter("Calc(*.ods)","*.ods")
  If oRes.OK = oFP.execute() Then
    sfileURL = convertToURL(oFP.selectedfiles(0))
    oArgs(0).Name="Hidden"
    oArgs(0).Value=True
    oDocB =  StarDesktop.loadComponentFromURL(sfileURL, "_blank", 0, oArgs())
    oDocBSheet = oDocB.Sheets.getByIndex(0)
    '書き出し位置に関する処理
    oDocBCur = oDocBSheet.createCursor()
    oDocBCur.gotoEnd()
    If oDocBSheet.RangeAddress.EndRow = oDocBCur.RangeAddress.EndRow Then
      nRow = 0
    Else
      nRow = oDocBCur.RangeAddress.EndRow + 1
    End If
    '*** ここまで ***
    oDocBSheet.getCellByPosition(0, nRow).String = oDocA.Sheets.getByIndex(0).getCellByPosition(0, 0).String
    oDocB.store()	'上書き保存
    If HasUnoInterfaces(oDocB,"com.sun.star.util.XCloseable") then
      oDocB.close(true)
    End If
    msgbox "処理終了"
  Else
    MsgBox "ファイルが選択されなかった"
  End If
End Sub