Hello:D
I have two macros that work properly and I would like to combine them into one. Both macros save data to files with different extensions (. ### and .okl). I would like the second macro just automatically write data to a file with the .okl extension with the same name and in the same place (same path) as the first macro.
Automatic - I mean without a save window.
Is it possible? I will be grateful for your help.
'First macro
Sub SaveNonEmptyV21V221
Dim aData As Variant, aOut As Variant, i As Long, j As Long
Dim sFileName As String
GlobalScope.BasicLibraries.loadLibrary("Tools")
aData = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("V21:V221").getDataArray()
ReDim aOut(UBound(aData))
j = -1
For i = 0 To UBound(aData)
If Trim(aData(i)(0)) <> "" Then
j = j + 1
aOut(j) = Trim(aData(i)(0))
EndIf
Next i
If j < 0 Then Exit Sub
ReDim Preserve aOut(j)
sFileName = StoreDocTo(aData(0)(0))
If sFileName = "" Then Exit Sub
SaveDataToFile(ConvertToURL(sFileName),aOut)
End Sub
Function StoreDocTo(DefaultName As String) as String
Dim oStoreDialog As Object
Dim ListAny(0) as Long
ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oStoreDialog.Initialize(ListAny)
oStoreDialog.AppendFilter("Rozkrój (.###)", ".###")
oStoreDialog.SetDisplayDirectory("C:\Ecru\Nowy Rozkrój")
oStoreDialog.SetDefaultName(DefaultName)
oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
If oStoreDialog.Execute() = 1 Then StoreDocTo = oStoreDialog.Files(0)
oStoreDialog.dispose()
End Function
'Second macro
Sub SaveNonEmptyW22W221
Dim aDataW22_W221 As Variant, aDataV21 As Variant, aOutW22W221 As Variant, i As Long, j As Long
Dim sFileName As String
GlobalScope.BasicLibraries.loadLibrary("Tools")
aDataW22_W221 = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("W22:W221").getDataArray()
aDataV21 = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("V21").getDataArray()
ReDim aOutW22W221(UBound(aDataW22_W221))
j = -1
For i = 0 To UBound(aDataW22_W221)
If Trim(aDataW22_W221(i)(0)) <> "" Then
j = j + 1
aOutW22W221(j) = Trim(aDataW22_W221(i)(0))
EndIf
Next i
If j < 0 Then Exit Sub
ReDim Preserve aOutW22W221(j)
sFileName = StoreDocTo(aDataV21(0)(0))
If sFileName = "" Then Exit Sub
SaveDataToFile(ConvertToURL(sFileName),aOutW22W221)
End Sub
Function StoreDocTo(DefaultName As String) as String
Dim oStoreDialog As Object
Dim ListAny(0) as Long
ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oStoreDialog.Initialize(ListAny)
oStoreDialog.AppendFilter("Obrzeże (.okl)", ".okl")
oStoreDialog.SetDisplayDirectory("C:\Ecru\Nowy Rozkrój")
oStoreDialog.SetDefaultName(DefaultName)
oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
If oStoreDialog.Execute() = 1 Then StoreDocTo = oStoreDialog.Files(0)
oStoreDialog.dispose()
End Function