Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic makaleleri » EXCELDE YTL-BÜYÜK Küçük Harf Değiştir. EKLENTİSİ
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Format OLayına Son

Yazar: awfulman

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 5091
Yayın Tar:25.11.2005
Yazar : halilhalil
Hit :5027

Bu Yazarın Yazıları Sadece bu yazarın  göster
Bu Yazıyı Tavsiye Et


Sub Auto_Open()
Call Buyuk_Kucuk_harf
End Sub
'
Sub Buyuk_Kucuk_harf()
Dim cb As CommandBar
Set cb = Application.CommandBars("Cell")
'
Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
MenuObject.Caption = "BÜYÜK/Küçük Harf Değiştir..."
MenuObject.BeginGroup = True
MenuObject.Tag = "MyTagR"
'
For MenuItem = 1 To 4
Set PopItem = MenuObject.Controls.Add(msoControlButton, 1, MenuItem, , True)
PopItem.FaceId = 7
With PopItem
Select Case MenuItem
Case 1
.Caption = "TÜMÜ BÜYÜK HARF"
Case 2
.Caption = "Yalnızca İlk Harf Büyük"
Case 3
.Caption = "tümü küçük harf"
Case 4
.Caption = "Normal Tümce Düzeni"
End Select
.OnAction = "degistir"
End With
Next
Set cb = Nothing
Set PopItem = Nothing
Set MenuObject = Nothing
End Sub
'
Sub Auto_Close()
Application.CommandBars("Cell").Reset
End Sub
'
Sub degistir()
Dim lngType As Long, MyRng As Range
Set MyWd = CreateObject("Word.Application")
Set MyDoc = MyWd.Documents.Add

Select Case CommandBars.ActionControl.Parameter
Case 1
lngType = 1
Case 2
lngType = 2
Case 3
lngType = 0
Case 4
lngType = 4
End Select

For Each MyRng In Selection
If (Not MyRng = Empty) And (Not IsNumeric(MyRng)) Then
MyWd.Selection.Text = MyRng.Text
MyWd.Selection.Range.Case = lngType
MyRng = MyWd.Selection.Text
End If
Next

MyDoc.Close False
MyWd.Quit
Set MyDoc = Nothing
Set MyWd = Nothing
End Sub
Public Function YTL(cTutar) As String
Dim cLira As Currency, cKurus As Currency, sStr As String, bEksi As Boolean
If Not IsNumeric(cTutar) Then

YTL = "GİRİLEN DE?ER SAYI DE?İL! YA DA 15 BASAMAKTAN BÜYÜK SAYI GİRMİŞSİNİZ "
End If


If cTutar > 999999999999999# Then
YTL = "GİRİLEN DE?ER SAYI DE?İL! YA DA 15 BASAMAKTAN BÜYÜK SAYI GİRMİŞSİNİZ "

Exit Function
End If

If cTutar < 0 Then cTutar = -cTutar: bEksi = True
T = "_"
cTutar = Format(cTutar, "#,##0.00")
cLira = Int(cTutar)
cKurus = Left((cTutar - cLira) * 100, 2)
If cLira = 0 Then
sStr = ""
Else
sStr = T & TL(cLira) & T & "YTL"
End If
If cKurus = 0 Then
sStr = sStr & ""
Else
sStr = sStr & IIf(sStr <> "", ", ", "") & "" & T & TL(cKurus) & T & "YKR"
End If
If sStr = "" Then sStr = "sıfır"
If bEksi Then sStr = "eksi" & sStr

YTL = sStr
End Function

Function TL$(cTutar)

Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim C(3)

b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
b$(3) = "Üç"
b$(4) = "Dört"
b$(5) = "Beş"
b$(6) = "Altı"
b$(7) = "Yedi"
b$(8) = "Sekiz"
b$(9) = "Dokuz"

y$(0) = ""
y$(1) = "On"
y$(2) = "Yirmi"
y$(3) = "Otuz"
y$(4) = "Kırk"
y$(5) = "Elli"
y$(6) = "Altmış"
y$(7) = "Yetmiş"
y$(8) = "Seksen"
y$(9) = "Doksan"

m$(0) = "Trilyon"
m$(1) = "Milyar"
m$(2) = "Milyon"
m$(3) = "Bin"
m$(4) = ""


a$ = Str(cTutar)

If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) _
< Asc("0")) Then GoTo hata
Next x

If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$

For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x

s$ = ""
For x = 0 To 4
C(1) = v((x * 3) + 1)
C(2) = v((x * 3) + 2)
C(3) = v((x * 3) + 3)
If C(1) = 0 Then
e$ = ""
ElseIf C(1) = 1 Then
e$ = "Yüz"
Else
e$ = b$(C(1)) + "Yüz"
End If
e$ = e$ + y$(C(2)) + b$(C(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BirBin") Then e$ = "Bin"
s$ = s$ + e$


Next x

If s$ = "" Then s$ = "Sıfır"
If pozitif = 0 Then s$ = "Eksi" + s$

TL$ = s$ '+ ".TL.Dır"""
GoTo tamam
hata: TL$ = "Hata"
tamam:
End Function











Yorumlar, eklemeler ve düşünceler
        yada hiç uğraşmadan ms tan ytl güncellemesini indirmek ve her tarafta kullanmak
;o)

   mahoni06, 30.11.2005 20:16
   burda sadece ytl ceviricisi degil kodlama mantıgını anlamak için guzel bir örnek verilmiş ytl cevirici yada usd cevirici mühim degil bence:)

   kriptonik007, 26.06.2008 16:58
   tbrkler sağol


   zagormen, 30.01.2009 10:47
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin