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