Page 1 of 1
Makro til at gemme fane
Posted: 31. Aug 2012 10:17
by COOL_M_F
Hvad jeg har:
Har lavet et regneark hvor jeg hælder en masse data ind i den første fane.
Der er lavet en knap der aktiverer en makro.
Makroen behandler data på første fane og opretter nye faner med de behandlede data.
Hvad jeg mangler:
Makroen skal kunne gemme de enkelte faner i hver sit regneark
Lige nu gør jeg det at jeg højreklikker på de enkelte faner og vælger flyt/kopier og vælger at flytte fanen til nyt dokument.
Derefter gemmer jeg det nye dokument.
Da jeg havner et sted mellem 50 og 100 faner og skal til at generere dem en del gange om året savner jeg en makro der kan gemme de enkelte faner for mig.
Er der nogen der kan hjælpe mig på rette spor
Posted: 1. Sep 2012 15:34
by Jens S
Hvis du absolut skal bruge makroer, kan du passende begynde her
http://wiki.openoffice.org/wiki/Documen ... readsheets
Formulerer du din søgning i Google rigtig, finder du også de rigtige kodestumper.
mvh
Jens
Posted: 1. Sep 2012 17:21
by Lodahl
hej,
Ønsker du at den skal kopiere alle faner til hvert sit ark, eller er det manuelt en fane ad gangen?
Posted: 1. Sep 2012 23:03
by Lodahl
Code: Select all
REM ***** BASIC *****
Sub Main
oDoc = thisComponent
oFileName = oDoc.Location
SplitSheets( oFileName )
End Sub
Sub SplitSheets( cCalcDocToSplit )
oDoc = thisComponent
nNumSheets = oDoc.getSheets().getCount()
nHighestSheetNumber = nNumSheets-1
For nSheetToSave = 0 To nHighestSheetNumber
oDoc = StarDesktop.loadComponentFromURL( ConvertToURL( cCalcDocToSplit ), "_blank", 0, Array() )
DeleteAllSheetsExcept( oDoc, nSheetToSave )
cNewName = thisComponent.sheets(nSheetToSave).Name
oDoc.storeToURL( ConvertToURL( DocumentFilePath & getPathSeparator & cNewName & ".ods" ), _
Array() )
oDoc.close( True )
Next
End Sub
Function DeleteAllSheetsExcept( oDoc, nSheetToKeep )
nNumSheets = oDoc.getSheets().getCount()
nHighestSheetNumber = nNumSheets-1
nSheetToDelete = nHighestSheetNumber
Do while nSheetToDelete > nSheetToKeep
oSheet = oDoc.getSheets().getByIndex( nSheetToDelete )
oDoc.getSheets().removeByName( oSheet.getName() )
nSheetToDelete = nSheetToDelete - 1
Loop
For i = 0 To nSheetToKeep - 1
' Delete the first Sheet.
nSheetToDelete = 0
' Get the Sheet.
oSheet = oDoc.getSheets().getByIndex( nSheetToDelete )
' Tell the document to remove it.
oDoc.getSheets().removeByName( oSheet.getName() )
Next
End Function
Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
If Not IsMissing( cName ) Then
oPropertyValue.Name = cName
EndIf
If Not IsMissing( uValue ) Then
oPropertyValue.Value = uValue
EndIf
MakePropertyValue() = oPropertyValue
End Function
Function DocumentFilePath
Dim oDoc
Dim sDocURL
oDoc = ThisComponent
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
GlobalScope.BasicLibraries.LoadLibrary("Tools")
End If
If (oDoc.hasLocation()) Then
sDocURL = oDoc.getURL()
DocumentFilePath = DirectoryNameoutofPath(sDocURL, "/")
End If
End Function