• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

TextBox'lara veya başka nesnelere formül ekleme...

Katılım
25 Ağustos 2009
Mesajlar
23
Excel Vers. ve Dili
2010 TR
Ekte örnek bir dosya var.
TextBox'lara veya başka form veya nesnelere formül girmek istiyorum. Bu mümkün mü?
 

Ekli dosyalar

Ekte örnek bir dosya var.
TextBox'lara veya başka form veya nesnelere formül girmek istiyorum. Bu mümkün mü?

merhaba
Sayfanın kod bölümüne
Kod:
Option Explicit
Private Sub Worksheet_Activate()
TextBox1 = Format(Sheets("veri").Range("B6"), "dd.mm.yyyy")
TextBox2 = Sheets("veri").Range("C6")
TextBox3 = Sheets("veri").Range("D6")
TextBox4 = Format(Sheets("veri").Range("E6"), "#,##0.00")
TextBox5 = "Yalnız" & " " & tl_yaz(TextBox4)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
TextBox1 = Format(Sheets("veri").Range("B6"), "dd.mm.yyyy")
TextBox2 = Sheets("veri").Range("C6")
TextBox3 = Sheets("veri").Range("D6")
TextBox4 = Format(Sheets("veri").Range("E6"), "#,##0.00")
TextBox5 = "Yalnız" & " " & tl_yaz(TextBox4)
End Sub
bu kod'u
boş bir module
Kod:
Function tl_yaz(sayi)
Dim a, b, c
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
b = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
c = Array("", "", "BİN", "MİLYON", "MİLYAR", "TRİLYON")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "YÜZ", "BİRYÜZ", "YÜZ")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "BİRBİN" Then son = Replace(son, "BİRBİN", "BİN")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & " TÜRKLİRASI"
If g = 2 And deger(2) <> 0 Then kr = " " & son & " KURUŞ"
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function
bu kodu kopyalayınız.
Not : Module'deki kod yazıya çevirme içindir.
textboxlara veriler iki şekilde gelmektedir.
1. döküm sayfasının A1 hücresine tıkladığınızda
2. döküm sayfasına giriş yaptığınızda
 
Çok teşekkürler, şimdi deneyeceğim.
Rakamı yazıya çevirme kodu var. Ben onunla uğraşmamak için örneğe böyle yazdım. Sağol.
 
Tekrar teşekkür ederim. Yazdığınız kod işe yaradı. Ancak TextBox'ların kenar çizgilerini kaldıramadığım için TextBox'ları Label'e çevirdim.
Yazdığınız kodu da Label'lere göre uyarladım. Tam istediğim gibi oldu.
Teşekkür ederim.
 
Tekrar teşekkür ederim. Yazdığınız kod işe yaradı. Ancak TextBox'ların kenar çizgilerini kaldıramadığım için TextBox'ları Label'e çevirdim.
Yazdığınız kodu da Label'lere göre uyarladım. Tam istediğim gibi oldu.
Teşekkür ederim.

kusura bakmayın o sorunuzu atlamışım
yapmanız gereken tasarım modunu açın - textbox'a sağ tuş tıklayın - özellikler - açılan menünün alt kısmında SpecialEffect yazan yerin karşına 0 olanı seçin ve menüyü kapatıp bakın.
rica ederim
:yazici:
 
Geri
Üst