質問編集履歴

2

タイトル変更

2019/08/25 06:51

投稿

Reach
Reach

スコア733

test CHANGED
@@ -1 +1 @@
1
- 【VBS】【LibreOffice】【OpenOffice】ファイルの保存ができない
1
+ 【VBS】【LibreOffice】【OpenOffice 解決済み】ファイルの保存ができない
test CHANGED
File without changes

1

OpenOfficeでは 解決したので

2019/08/25 06:51

投稿

Reach
Reach

スコア733

test CHANGED
File without changes
test CHANGED
@@ -89,3 +89,175 @@
89
89
 
90
90
 
91
91
  ```
92
+
93
+ LibreOfficeでは エラーが出ますが OpenOffice では 下記コードで 動作するみたいです
94
+
95
+ ```vbs
96
+
97
+ call SaveFile(oFile)
98
+
99
+
100
+
101
+ Function urlEncode(str)
102
+
103
+ Dim oSjisStream, oUTFStream
104
+
105
+ Dim strSjis, strUTF, strEnc
106
+
107
+ Dim result()
108
+
109
+ Dim space
110
+
111
+ space = "%20"
112
+
113
+ urlEncode = ""
114
+
115
+ If str = "" Then Exit Function
116
+
117
+ '
118
+
119
+ set oUTFStream = CreateObject("ADODB.Stream")
120
+
121
+ oUTFStream.Mode = 3
122
+
123
+ oUTFStream.Type = 2 'text data
124
+
125
+ oUTFStream.CharSet = "UTF-8"
126
+
127
+ oUTFStream.Open
128
+
129
+ oUTFStream.WriteText str
130
+
131
+ '
132
+
133
+ oUTFStream.Position = 0 'rewaind
134
+
135
+ oUTFStream.Type = 1 'binary data
136
+
137
+ oUTFStream.Position = 3
138
+
139
+ strUTF = oUTFStream.Read
140
+
141
+ ReDim result(UBound(strUTF)+1) 'into byte array
142
+
143
+ For i=1 To UBound(strUTF)+1
144
+
145
+
146
+
147
+ b = AscB(MidB(strUTF, i, 1))
148
+
149
+
150
+
151
+ if (b >= 97 and b<= 122) or (b >= 65 and b<= 90) or (b >= 48 and b<= 57) or (b >= 45 and b<= 46) or (b = 95) or (b = 126) then
152
+
153
+ result(i) = Chr(b)
154
+
155
+ ElseIf b = 32 then
156
+
157
+ result(i) = space
158
+
159
+ ElseIf (b >= 0 and b<= 15) then
160
+
161
+ result(i) = "%0" & Hex(b)
162
+
163
+ Else
164
+
165
+ result(i) = "%" & Hex(b)
166
+
167
+ end if
168
+
169
+ Next
170
+
171
+
172
+
173
+ urlEncode = Join(result, "")
174
+
175
+
176
+
177
+
178
+
179
+ set oSjisStream = Nothing
180
+
181
+ set oUTFStream = Nothing
182
+
183
+ End Function
184
+
185
+
186
+
187
+ SUB SaveFile(oFile)
188
+
189
+
190
+
191
+
192
+
193
+
194
+
195
+ Dim saveparam0,saveparam1,saveparam2
196
+
197
+ Dim storeProps(2)
198
+
199
+
200
+
201
+ passname = "file:///" + urlEncode(oFile)
202
+
203
+
204
+
205
+ passname = Replace(passname,"\","/")
206
+
207
+ passname = Replace(passname,"%5C","/")
208
+
209
+ passname = Replace(passname,"%3A",":")
210
+
211
+ passname = Replace(passname,"%2E",".")
212
+
213
+
214
+
215
+
216
+
217
+ Set saveparam0 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
218
+
219
+ saveparam0.Name = "URL"
220
+
221
+ saveparam0.Value = passname
222
+
223
+ Set storeProps(0) = saveparam0
224
+
225
+
226
+
227
+ Set saveparam1 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
228
+
229
+ saveparam1.Name = "FilterName"
230
+
231
+ saveparam1.Value = "MS Excel 97"
232
+
233
+ Set storeProps(1) = saveparam1
234
+
235
+
236
+
237
+ Set saveparam2 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
238
+
239
+ saveparam2.Name = "Overwrite"
240
+
241
+ saveparam2.Value = True
242
+
243
+ Set storeProps(2) = saveparam2
244
+
245
+
246
+
247
+ dim Frame , DispatchHelper
248
+
249
+ Set Frame = oCalcDoc.getCurrentController().getFrame()
250
+
251
+
252
+
253
+ Set DispatchHelper = OSM.createInstance("com.sun.star.frame.DispatchHelper")
254
+
255
+ call DispatchHelper.executeDispatch(Frame, ".uno:SaveAs", "", 0, storeProps)
256
+
257
+
258
+
259
+
260
+
261
+ end sub
262
+
263
+ ```