LibreOfis de Hücre Rengine Göre Toplama

[taydin]

Bence Microsoft'a para kazandırma, dünyaya salacakları yeni virüs için finansman sağlama. Ana hatlarıyla yapılacaklar belli, biraz üzerinde çalışırsan çözersin sen.

 

[Gokrtl]

Para vermem zaten abi.

İki gün önce üzerinde çalışıp makroyu fonksiyona çevirdim. Toplamada hata yapıyordu. Biraz daha kurcalayınca belgeyi kurtarılamayacak şekilde bozdum. Kısa bir panik ataktan sonra libreofis ana klasörü içinde makroların tutulduğu tabloyu bulup fonksiyonu silince belge açıldı. Önemsiz belge üzerinde çalışmak lazım.

 

[Gokrtl]

(Konu dışı)

Bir virüs vakası daha patlarda sağ kalırsam bir kaç yıl içinde zengin olurum. Korona virüs zamanı borsadan anlamadığıma çok feci pişman oldum.

 

[Gokrtl]

@taydin abi bizim editörde kod eklerken Basic yada V Basic seçeneği yok. Kodu eklerken PHP ekleyip açıklama satırlarını // yaparak belirtmek zorunda kaldım.


Aşağıdaki formülü yazdım.

Function renkTopla(sutun,satir,renk,pos)
oSheet = ThisComponent.CurrentController.ActiveSheet
For sutunn = sutun to 10 //REM 0=A 1=B 2=C sutunları
  For satirr = satir to 19 //REM 0=birinci satır, 1=ikinci satır 2=içinci satır ....
    hucre = oSheet.getCellByPosition(sutunn, satirr) //REM örnek (0,0)=A1 sutunu, (2,3)=C4 sutunu ...
    if (hucre.cellBackColor>0) Then //REM hucre rengi beyazdan farklı bir renk ise işlem yapılacak
      For bulunan_satir = renk to 31 //REM 3 tane renk için satır sayısı belirtildi. Fazla renk varsa sayıyı artırın.
        bulunan = oSheet.getCellByPosition(pos, bulunan_satir) //REM toplamları G sutununa yazmak için 6 yazıldı. Çünkü G sutunu 6. sutundur.
        if bulunan.cellBackColor = hucre.cellBackColor Then
          bulunan.setValue(bulunan.getValue()+hucre.getValue())
        End if
      Next bulunan_satir
    End If
  Next satirr
Next sutunn

End Function

Kullanımı =renkTopla(1;10;30;12) şeklinde.
1: toplanacak hücrelerin sütun başlangıcı. Bu rakam B sütununa denk geliyor.
10: toplanacak hücrelerin satır başlangıcı. Bu rakam da 11'inci satıra denk geliyor.
30: Toplamın hangi hücreye yazdırılacağı. Bu rakamda 31'inci satıra denk geliyor.
12: Toplamın hangi sütuna yazdırılacağı. Bu rakam da M sütununa denk geliyor.

Fonksiyon ilk deneme de çalışıyor ve doğru sonuç veriyor.
Ancak fonksiyonu ikinci kez kullanırsak belge kurtarılamayacak şekilde bozuluyor.

Fonksiyonu makro olarak ekledikten sonra "makroyu çalıştır" dememiz gerekiyor. O durumda da şu hatayı alıyorum.

"
Basic, Standard.Module1.renkTopla betiği çalıştırılırken, betik dili çatı hatası oluştu.

Mesaj: wrong number of parameters! at C:/cygwin64/home/buildslave/source/libo-core/scripting/source/basprov/basscript.cxx:199"

 

[taydin]

Şöyle bir alternatif deneyebilirsin. Masraf sütunun yanına bir sütun daha koy. Bu ilave sütunda mesela ödenecek fatura tutarı olsun. Toplama yapılan sütuna da, renge göre ya 0 koy, yada yan sütundaki fatura tutarını koy. Aşağıda toplama yapan sütun da normal işlem yapsın. Böyle yaparsan kontrolü de kolay olur. Ayrıca ödenmiş olan faturada kaç para ödenmiş her zaman görebilirsin.

 

[Gokrtl]

Şöyle bir alternatif deneyebilirsin. Masraf sütunun yanına bir sütun daha koy. Bu ilave sütunda mesela ödenecek fatura tutarı olsun. Toplama yapılan sütuna da, renge göre ya 0 koy, yada yan sütundaki fatura tutarını koy. Aşağıda toplama yapan sütun da normal işlem yapsın. Böyle yaparsan kontrolü de kolay olur. Ayrıca ödenmiş olan faturada kaç para ödenmiş her zaman görebilirsin.

Abi tablo 1.mesajdaki gibi.
Yani masraflar tek bir sütunda değil. iş orada karışıyor zaten. Tek sütun olsa filtre bile kullanır çözerim işi.

 

[Gokrtl]

Dün gece saat 3'e kadar libreofis basic dilini anlamaya çalıştım.
Ne doğru dürüst video bulabildim, ne de kendi bilgi sayfasında yazanları anlayabildim.
Forumlarına bile üye olmayı beceremedim.

En nihayetinde sabrımın sonuna gelip Microsoft Ofis kurdum ve EXEL'e geçtim.
Günlerdir uğraştığım işi aşağıdaki kod ile 1 dakikada hallettim. Ayrıca dökümanı libreden exele çevirirken yaşadığım bir kaç sorunu ufak tefek araştırmalar ile hızlıca çözdüm.

Evet libreofisin ücretsiz olması güzel ama başımız sıkıştığında desteğin olmaması çok kötü bir durum. Microsoft ofiste ne arasan lap diye karşına çıkıyor. istemediğin kadar bilgi var. Şuanda kendimi tofaştan inip BMW ye binmiş gibi hissediyorum.

Function renkTopla(bolge As Range, renk As Range) As Double
    renkTopla = 0
    Dim Cell
    Color_Index = renk.Interior.ColorIndex
    For Each Cell In bolge
        If (Cell.Interior.ColorIndex = Color_Index) Then
            renkTopla = renkTopla + Cell.Value
        End If
    Next Cell
End Function