Hallo mikeleb,
Ich habe mir vor geraumer Zeit eine Lieferübersicht gebastelt.
In Tabelle 2 sind Artikelnummern in Tabelle 3 gebe ich dann die Lieferungen ein.
Jetzt habe ich mir ein Makro gebastelt das:
1. prüft ob die Artikelnummer schon da ist (tabelle 3)
wenn ja springt der Cursor zu dieser Nummer
2. prüft ob es die Artikelnummer gibt (tabelle 2),
wenn nicht springt der Cursor zur nächst kleineren Artikelnummer in Tabelle 2
3. wenn die Nummer nicht da ist sie in Tabelle 3 einfügt.
Das geht bestimmt auch eleganter als ich es gemacht habe, aber dank eurer Hilfe funktioniert es.
Hier mein Makro:
Sub Artikelnummer
Dim oZielzelle As Object
sArtikel=Inputbox("Artikelnummer")
odoc = thiscomponent
oSheet = odoc.currentcontroller.activesheet.getCellRangeByPosition( 1, 0, 1, 101 )
oSearchDescriptor = oSheet.createSearchDescriptor()
oSearchDescriptor.Searchstring = sArtikel
oSearchDescriptor.SearchWords = True
oFound = oSheet.FindFirst(oSearchDescriptor)
odoc.CurrentController.Select(oFound)
if oFound is Nothing then
oFunctionAccess = createUnoService("com.sun.star.sheet.FunctionAccess")
oXCellRange = thiscomponent.Sheets(1).getCellRangeByName("a2:a450")
Dim args( 1 ) As Variant
args(0) = oXCellRange
args(1) = sArtikel
result = oFunctionAccess.callFunction( "COUNTIF", args() )
if result = 1 then
oView = oDoc.CurrentController
oTab=ThisComponent.Sheets(2)
'Ermittlung der ersten freien Zeile in Spalte b
nZeile=oTab.Columns(1).queryEmptyCells.RangeAddresses(0).startrow
oZielzelle = oTab.getCellByPosition(1,nZeile)
oView.Select(oZielzelle)
oZielzelle.value = sArtikel
else
doc = thisComponent
fa = createUnoService("com.sun.star.sheet.FunctionAccess")
ctrl = doc.CurrentController
sheet = doc.Sheets(1)
arr = sheet.getCellRangeByName("a1:a450")
num = int(sArtikel)
position = fa.callFunction("match", array(num, arr))
cell = sheet.getCellByPosition(0,position-1)
'oder
'cell = sheet.getCellRangeByName("B" & position )
ctrl.select(cell)
end if
else
endif
End Sub
Vielen Dank nochmal Gruß MT