Makro til at gemme fane

[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

[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

[Lodahl]

hej,
Ønsker du at den skal kopiere alle faner til hvert sit ark, eller er det manuelt en fane ad gangen?

[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