Excel commando omzetten naar Calc commando

Status
Niet open voor verdere reacties.

Tetje

Gebruiker
Lid geworden
21 okt 2008
Berichten
11
Hallo

Ik heb in Excel een tablat gemaakt waar ik mijn meterstanden in kan geven en deze dmv een button kan plaatsen in de desbetreffende week nummer.

Alleen nu heb ik geen Excel meer maar Open Office.
In Open Office werkt deze "kopieer" Button niet meer.
Weet iemand wat er in de code veranderd moet worden om deze button weer werkend te krijgen?
Het gaat om de Button: "Doorkopieren"

Alvast bedankt

Peter
 

Bijlagen

Oops. Dat was nogal wat.

Uiteindelijk heb ik het volgens mij wel voor elkaar gekregen, met uitzondering van 1 ding.

Als het weeknummer in kolom A ontbreekt krijg je geen melding daarvan en wordt er dus niets gekopieerd. Hij vindt namelijk een NULL-object dan en ik weet niet hoe ik dan verder moet.

Ik heb dat niet voor elkaar kunnen krijgen. (Ik hoop dat je zonder kunt. Kwestie van zorgen dat er inderdaad weeknummers staan ;-) )

Ik heb de originele Excel-macro aangepast en die staat nu in het document. Volgens mij kopieert ie de waarden naar de juiste plekken.

De macro is nu weer gekoppeld aan de knop DOORKOPIEREN en wel dusdanig dat bij het indrukken van de knop wordt gekopieerd

O ja, voor de liefhebbers:

Hier zijn de macro's

Code:
Option Explicit
 
Private Sub CommandButton1_Click()
 Dim oDoc as Object
 Dim oSheet as Object
 Dim Range
 Dim oCell

 
 oDoc = ThisComponent
 oSheet = ThisComponent.Sheets.getByName("Verbruik 2009")
 
   If oSheet.getCellRangeByName("B4").Value = "" OR oSheet.getCellRangeByName("B4").String = ""_
             OR oSheet.getCellRangeByName("C5").Value = "" OR oSheet.getCellRangeByName("C5").String = ""_
             OR oSheet.getCellRangeByName("D4").Value = "" OR oSheet.getCellRangeByName("D4").String = ""_
             OR oSheet.getCellRangeByName("E5").Value = "" OR oSheet.getCellRangeByName("E5").String = ""_
             OR oSheet.getCellRangeByName("F4").Value = "" OR oSheet.getCellRangeByName("F4").String = ""_
             OR oSheet.getCellRangeByName("G5").Value = "" OR oSheet.getCellRangeByName("G5").String = "" then
     MsgBox ("Nog niet alle gegevens zijn ingevuld !", 64, "NOG GEGEVENS INVULLEN S.V.P.!")      'nog ergens foute of ontbrekende gegevens
    Exit Sub                                               'stoppen
   Else
Dim c As Object
     Set c = SimpleSheetSearch(oSheet.getCellRangeByName("A4").Value, oSheet.getCellRangeByName("A17:A68"), false)  'zoek cel met overeenkomstig weeknr
     If c.string > 0 OR c.value  >0 Then               'heb je die cel gevonden ?                                                             
     ThisComponent.CurrentController.Select(c)
 
Dim oRange as Object
Dim oCell1 as Object
Dim oCell2 as Object

'*************************************************************
'Kopieer de waarde uit B4 naar de juiste plaats in de gegevens
'*************************************************************
          oRange = thisComponent.getCurrentSelection.getRangeAddress
          oCell1 =  oSheet.getCellByPosition(oRange.StartColumn + 1,oRange.StartRow)
          oCell2 =  oSheet.getCellRangeByName("B4")

          oCell1.setDataArray( oCell2.getDataArray )

'*************************************************************
'Kopieer de waarde uit D4 naar de juiste plaats in de gegevens
'*************************************************************
          oRange = thisComponent.getCurrentSelection.getRangeAddress
          oCell1 =  oSheet.getCellByPosition(oRange.StartColumn + 3,oRange.StartRow)
          oCell2 =  oSheet.getCellRangeByName("D4")

          oCell1.setDataArray( oCell2.getDataArray )

'*************************************************************
'Kopieer de waarde uit F4 naar de juiste plaats in de gegevens
'*************************************************************
          oRange = thisComponent.getCurrentSelection.getRangeAddress
          oCell1 =  oSheet.getCellByPosition(oRange.StartColumn + 5,oRange.StartRow)
          oCell2 =  oSheet.getCellRangeByName("F4")

          oCell1.setDataArray( oCell2.getDataArray )

     Else
       MsgBox "Weeknummer " & oSheet.getCellRangeByName("A4").Value & " niet gevonden"  'niet gevonden weeknr
     End If
   End If
 End Sub


REM Find the first cell that contains sString$
REM If bWholeWord is True, then the cell must contain ONLY the text
REM as indicated. If bWholeWord is False, then the cell must only contain
REM the requested string.
Function SimpleSheetSearch(sString$, oSheet, bWholeWord As Boolean) As Variant
  Dim oDescriptor
  Dim oFound

  REM Create a descriptor from a searchable document.
  oDescriptor = oSheet.createSearchDescriptor()
  REM Set the text for which to search and other 
  REM http://api.openoffice.org/docs/common/ref/com/sun/star/util/SearchDescriptor.html 
  With oDescriptor
    .SearchString = sString$
    REM These all default to false
    REM SearchWords forces the entire cell to contain only the search string
    .SearchWords = bWholeWord
    .SearchCaseSensitive = False
  End With
  REM Find the first one
  oFound = oSheet.findFirst(oDescriptor)
  SimpleSheetSearch = oFound
  
  REM Do you really want to find more instances
  REM You can continue the search using a cell if you want!
  'Do While Not IsNull(oFound)
  '  Print oFound.getString()
  '  oFound = oSheet.findNext( oFound, oDescriptor)
  'Loop
End Function
 

Bijlagen

Laatst bewerkt:
Bedankt DiGro

@ DiGro

Bedankt, super. :thumb:

Het werkt weer precies zoals het was.

Dank je

Peter
 
Het is graag gedaan. Leuk om mee te puzzelen.

Nog vergeten te vermelden:

Als je een nieuw blad maakt voor 2010 en die "Verbruik 2010"noemt,
moet je in de macro "Verbruik 2009" vervangen door "Verbruik 2010"
anders worden de gegevens op het verkeerde werkblad ingevuld.

Schoot mij te binnen toen vorige mail al weg was.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan