formule van excel naar calc

Status
Niet open voor verdere reacties.
H

Hans83

Gebruiker
Lid geworden
13 mrt 2008
Berichten
31
Wie kan me hier helpen met deze macro van Excel aan te passen voor Calc.
ik kom er zelf niet uit.


Sub Opslaan()

Range("C15").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="D:\Boeking\2008\Factuur\Factuur " & Range("C15").Value & ".xlsm"

End Sub


Groet Hans
 
zo ver ben ik.

REM ***** BASIC *****



sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$C$15"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "URL"
args3(0).Value = "file:///D:/Boeking/2008/20080016.ods"
args3(1).Name = "FilterName"
args3(1).Value = "calc8"

dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args3())


end sub

hij moet het bestand opslaan zoals wat er in C15 staat?
dus nu 20080016.ods maar de volgende keer een ander getal.
wie kan me helpen
 
Hans83 zei:
zo ver ben ik.
Klik om te vergroten...
Da's best al ver hoor

Hans83 zei:
wie kan me helpen
Klik om te vergroten...

probeer dit eens:
Code: 
[COLOR="DarkGreen"]Sub Opslaan
Dim Cel as String
Dim oDoc as Object

   oDoc = ThisComponent
   Cel = thiscomponent.Sheets(0).getCellRangeByName("C15").String
   cFile = "D:/Boeking/2008/2/"& Cel
   cURL = ConvertToURL( cFile + ".ods" )
   oDoc.storeAsURL( cURL, Array() )  
End Sub[/COLOR]

Anders heb je hier misschien iets aan:
http://www.oooforum.org/forum/viewtopic.phtml?t=4996&highlight=save+csv
 
nog een paar vragen.

1. hoe open en sluit je een bestand in een macro?

2. wie kan deze vertalen. kom er zelf niet uit.

Sub Afdrukken()


Sheets("Factuur").Visible = True

Sheets("Factuur").Select

Selection.AutoFilter Field:=1

Selection.AutoFilter Field:=1, Criteria1:="@"

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True

ActiveWorkbook.Save

End Sub


Alvast bedankt
 
Hans83 zei:
1. hoe open en sluit je een bestand in een macro?
Klik om te vergroten...
Deze staat in de link in mijn vorige post
Code: 
   '-----
   ' Use this line to create a NEW calc document
   '  and assign it to variable oDoc.
   oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Array() )
   '-----
   
   '-----
   ' Use this instead to open an EXISTING calc document,
   '  and assign it to variable oDoc.
'   cFile = "C:\Documents and Settings\danny\Desktop\MyCalc" ' Windows
'   cFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux
'   cURL = ConvertToURL( cFile + ".sxc" )
'   oDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, Array() )
   '-----
Kan zijn dat je StarDesktop moet vervangen door ThisComponent

Code: 
   '-------
   ' Now close the document
'   oDoc.close( True )
   '-------

Hans83 zei:
2. wie kan deze vertalen. kom er zelf niet uit.

Sub Afdrukken()


Sheets("Factuur").Visible = True

Sheets("Factuur").Select

Selection.AutoFilter Field:=1

Selection.AutoFilter Field:=1, Criteria1:="@"

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True

ActiveWorkbook.Save

End Sub


Alvast bedankt
Klik om te vergroten...

Zou iets moeten zijn als:
Code: 
Sub Afdrukken()

Dim oDoc as object
Dim oSheet as object 

oDoc=Thiscomponent  'dit document

oSheet=ThisComponent.Sheets.getByName("Factuur") 

 // --- sorteer op eerste kolom, oplopend ---
 
 // definieer het veld waarop gesorteerd moet worden
 aSortFields = new com.sun.star.table.TableSortField[0]
 aSortFields[0] = new com.sun.star.table.TableSortField()
 aSortFields[0].Field = 1
 aSortFields[0].IsAscending = true
 
 // definieer de sorteer beschrijving
 aSortDesc = new com.sun.star.beans.PropertyValue[1]
 aSortDesc[0] = new com.sun.star.beans.PropertyValue()
 aSortDesc[0].Name = "SortFields";
 aSortDesc[0].Value = aSortFields;

 // voer het sorteren uit
 xSort = com.sun.star.util.XSortable 
 xSort.sort(aSortDesc); 

printOpts = new PropertyValue[2]
printOpts[0] = new PropertyValue()
printOpts[0].Name = "Copies"
printOpts[0].Value = "2"    
printOpts[1].Name = "Collate"
printOpts[1].Value = "true" 

xPrintable.print(printOpts)

   ' Now save the document

   ' Prepare the filename to save.
   ' We're going to save the file in several different formats,
   '  but all based on the same filename.
   cFile = "C:\Documents and Settings\dbrewer\Desktop\MyCalc" ' Windows
'   cFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux

   ' Now save the spreadsheet in native OOo Calc format.
   cURL = ConvertToURL( cFile + ".ods" )
   oDoc.storeAsURL( cURL, Array() )
End sub

LET OP: Ik heb geen idee of dit werkt. Ik heb het slechts bij elkaar gesprokkeld.
 
ik zal het binnen kort even uit proberen als ik tijd heb.
alvast bedankt
 
Dit werkt niet

Code: 
sub Export
 

   '-------
   ' Now close the document
   oDoc.close( True )
   '------- 

end sub

deze wel maar hij sluit alle open documenten, zoek er een die alleen het document afsluit waar ik de macro op uitvoer.

Code: 
ThisComponent.setModified(false)
ThisComponent.close(true)

nog een vraag?
ik kom hier niet uit. hij plakt nu de regel die hij koppieert in het verkeerde document en niet in het geopende document hoe moet ik dit oplossen

Code: 
sub Export
 
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$G$15:$W$15"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

   '-----
   ' Use this instead to open an EXISTING calc document,
   '  and assign it to variable oDoc.
   cFile = "D:\Boeking\2008\Gegevens" ' Windows
   cURL = ConvertToURL( cFile + ".ods" )
   oDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, Array() )
   '-----

rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
 
args1(0).Name = "Nr"
args1(0).Value = 1

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$Q$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$A$3:$Q$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(5) as new com.sun.star.beans.PropertyValue
args5(0).Name = "Flags"
args5(0).Value = "SVDNT"
args5(1).Name = "FormulaCommand"
args5(1).Value = 0
args5(2).Name = "SkipEmptyCells"
args5(2).Value = false
args5(3).Name = "Transpose"
args5(3).Value = false
args5(4).Name = "AsLink"
args5(4).Value = false
args5(5).Name = "MoveMode"
args5(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args5())

rem ----------------------------------------------------------------------
dim args6(0) as new com.sun.star.beans.PropertyValue
args6(0).Name = "Nr"
args6(0).Value = 2

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args6())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())

rem ----------------------------------------------------------------------
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = "ToPoint"
args8(0).Value = "$A$5:$J$5"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args8())

rem ----------------------------------------------------------------------
dim args9(0) as new com.sun.star.beans.PropertyValue
args9(0).Name = "EndCell"
args9(0).Value = "$J$4"

dispatcher.executeDispatch(document, ".uno:AutoFill", "", 0, args9())

rem ----------------------------------------------------------------------
dim args10(0) as new com.sun.star.beans.PropertyValue
args10(0).Name = "ToPoint"
args10(0).Value = "$A$4:$J$5"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())

rem ----------------------------------------------------------------------
dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = "Nr"
args11(0).Value = 3

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args11())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
  

end sub
 
Laatst bewerkt:
Hans,

ik denk dat dat kopiëren ligt aan het feit dat de onderscheidenlijke documenten niet juist zijn gedefinieerd.

Zoals ik het lees probeer je van document 1 naar document 2 te kopiëren.

Document 1 zal vermoedelijk zin gedefinieerd als het object document
Document 2 is het object oDoc

Je zult dus voor het plakken 'document' moeten vervangen door 'oDoc'

Uit de tekst begrijp ik dat je plakt in document en dat is dus het werkblad van waaruit je het gekopieerd hebt.

Het automatisch opnemen van macro's is niet je van het in OOo en levert veel overbodige code op.
In dit document staat een groot aantal macro's. Ik knip en plak daar regelmatig uit

OpenOffice.org Macro document

Kun je de originele Excel-macro plaatsen, dan wordt het voor mij wat makkelijker om te zoeken wat we nodig hebben :)
 
Hoi

dit is het origineel

Code: 
Sub Export()
'
' Export Macro
'

'
    Range("G15:W15").Select
    Selection.Copy
    Workbooks.Open Filename:="D:\Boeking\2008\Gegevens.xlsm"
    Sheets("Gegevens").Select
    Range("A3:Q3").Select
    Range("Q3").Activate
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Opsomming").Select
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A5:J5").Select
    Selection.AutoFill Destination:=Range("A4:J5"), Type:=xlFillDefault
    Range("A4:J5").Select
    Sheets("Gegevens").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

alvast bedankt
 
Ga ik zo even kijken.
In de tussentijd heb ik dit verzonnen.

Deze kopieert van doc 1 , Blad 1, het bereik A15:W15 naar
doc2, Blad 1, A3:Q3 (waar doc2 = E:/Boeking/2008/Gegevens.ods" ) !!!
Dus even voorzichtig zijn als je hem uitprobeert

Code: 
Sub KopieerSelectie

  Dim doc1
  Dim doc2
  Dim oSheet, oCRange as Object
  
  doc1 = ThisComponent
  oSheet = doc1.Sheets.getByName("Blad1")

  'stel het bereik in dat je wilt kopiëren
  oCRange = oSheet.getCellRangeByName("G15:W15")
  ThisComponent.getCurrentController.select(oCRange)

  dispatchURL(doc1,".uno:Copy")
  
  cFile = "E:/Boeking/2008/Gegevens" ' Windows
  cURL = ConvertToURL( cFile + ".ods" )
  doc2 = StarDesktop.loadComponentFromUrl(cUrl , _
                      "_blank",0,dimArray())

  oSheet = doc2.Sheets.getByIndex(0)
  doc2.CurrentController.Select(oSheet.GetCellRangeByName("A3:Q3"))
  
  dispatchURL(doc2,".uno:Paste")
  
  
End Sub

Focus blijft nog op Gegevens.ods. Daar ben ik nog niet uit
 
Vergat even dat je deze macro ook nodig hebt om de vorige te laten werken

Code: 
Sub dispatchURL(oDoc, aURL)
  Dim noProps()
  Dim URL As New com.sun.star.util.URL

  frame = oDoc.getCurrentController().getFrame()
  URL.Complete = aURL
  transf = createUnoService("com.sun.star.util.URLTransformer")
 transf.parseStrict(URL)

  disp = frame.queryDispatch(URL, "", _
            com.sun.star.frame.FrameSearchFlag.SELF _
         OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
  disp.dispatch(URL, noProps())
End Sub

Plaats hem onder die andere
 
Hans,

volgens mij heb ik hem zo compleet.

Kopieer onderstaande macro's en kijk eens of het werkt (als je de benodigde aanpassingen hebt gedaan)

Ik ben er van uit gegaan dat de werkbladen Gegevens en Opsomming zich allebei in Gegevens.ods bevinden.

Ook ben ik er van uit gegaan dat je kopieert vanuit een geopend Calc-document en wel vanaf Blad 1.

Ik ben er niet zeker van of alles naar de juiste plaats wordt gekopieerd, maar dat zijn minimale aanpassingen denk ik.

Code: 
Sub ExportCalc

Dim doc1
Dim doc2
Dim oSheet, oCRange as Object
  
  doc1 = ThisComponent
  oSheet = doc1.Sheets.getByName("Blad1")

  'stel het bereik in dat je wilt kopiëren
    oCRange = oSheet.getCellRangeByName("G15:W15")
    ThisComponent.getCurrentController.select(oCRange)

    dispatchURL(doc1,".uno:Copy")
  
  'open het bestand E:/Boeking/2008/Gegevens.ods
    cFile = "E:/Boeking/2008/Gegevens" ' Windows
    cURL = ConvertToURL( cFile + ".ods" )
    doc2 = StarDesktop.loadComponentFromUrl(cUrl , _
                      "_blank",0,dimArray())
  'ga naar het blad gegevens en selecteer A3 t/m Q3
    oSheet = doc2.Sheets.getByName("Gegevens")
    doc2.CurrentController.Select(oSheet.GetCellRangeByName("A3:Q3"))

  'voeg 1 rij in en schuif de aanwezige gegevens naar beneden
    oCell = doc2.getCurrentSelection
    nRow = oCell.getRangeAddress().StartRow
    oSheet.Rows.insertByIndex( nRow, 1)
    
  'plak de gekopieerde gegevens
    dispatchURL(doc2,".uno:Paste")
  
  'Ga naar het blad Opsomming in Gegevens.ods en selecteer rij 4
    oSheet = doc2.Sheets.getByName("Opsomming")
    doc2.CurrentController.Select(oSheet.Rows("3:3"))
    dispatchURL(doc2, ".uno:Copy", "", 0, Array())

  'voeg 1 rij in en schuif de aanwezige gegevens naar beneden
    oCell = doc2.getCurrentSelection
    nRow = oCell.getRangeAddress().StartRow
    oSheet.Rows.insertByIndex( nRow, 1)

  'plak de gekopieerde gegevens
    dispatchURL(doc2,".uno:Paste"

  'selecteer A5 t/m J5 op het blad Opsomming
    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = "$A$5:$J$5"

    dispatchURL(doc2, ".uno:GoToCell", "", 0, args1())

 'Vul automatisch het gebied A4 t/m J5  (ofwel kopieer A5:J5 naar A4;J4)
    dim args2(0) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "EndCell"
    args2(0).Value = "$J$4"

    dispatchURL(doc2, ".uno:AutoFill", "", 0, args2())

  rem ----------------------------------------------------------------------
    dim args3(0) as new com.sun.star.beans.PropertyValue
    args3(0).Name = "ToPoint"
    args3(0).Value = "$A$4:$J$5"

    dispatchURL(doc2, ".uno:GoToCell", "", 0, args3()) 

  'ga naar het blad Gegevens en selecteer cel A1
    oSheet = doc2.Sheets.getByName("Gegevens")
    doc2.CurrentController.Select(oSheet.GetCellRangeByName("A1"))
    
  ' sla het document Gegevens.ods op als het gewijzigd is en sluit het dan
     If (doc2.isModified) Then
         If (doc2.hasLocation AND (Not doc2.isReadOnly)) Then
       doc2.store()
         Else
       doc2.setModified(False)
        End If
     End If

   'sluit Gegevens.ods
    doc2.close(True)

End Sub

Sub dispatchURL(oDoc, aURL)
  Dim noProps()
  Dim URL As New com.sun.star.util.URL

  frame = oDoc.getCurrentController().getFrame()
  URL.Complete = aURL
  transf = createUnoService("com.sun.star.util.URLTransformer")
 transf.parseStrict(URL)

  disp = frame.queryDispatch(URL, "", _
            com.sun.star.frame.FrameSearchFlag.SELF _
         OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
  disp.dispatch(URL, noProps())
End Sub

Suc6
 
Bedank ik ga het uitproberen en ander wat aan verander. bedankt.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan