Hot Fox: Re: ]] XL-mania [[ konvert dari phone number ke huruf

quarta-feira, 30 de setembro de 2009

Re: ]] XL-mania [[ konvert dari phone number ke huruf

Alternatif lain fungsi terbilang nomor telepon :

Function notelp(target As String) As String
'cara pemakaian =notelp(sel target)

Dim angka, teks As Variant
Dim x As Integer

angka = Split("( ) - 0 1 2 3 4 5 6 7 8 9")
teks = Split("Kurung.Buka Kurung.Tutup [Strip] Nol Satu Dua Tiga Empat
Lima Enam Tujuh Delapan Sembilan")

For x = 0 To 12
notelp = Trim(Replace(target, angka(x), teks(x) & " "))
target = notelp
Next

notelp = Replace(notelp, "Kurung.Buka", "[Kurung Buka]")
notelp = Replace(notelp, "Kurung.Tutup", "[Kurung Tutup]")

If notelp = "" Then: notelp = "Nomor yang anda panggil belum terpasang"

End Function

saya ambil dari blog ini :
http://pitikcilik.blogspot.com/2009/09/vba-excel-terbilang-untuk-nomor-telepon.html

On 9/30/09, Puthut Wibowo <puthut_vai@yahoo.com> wrote:
> Om om om........ kayak gini yak oom :
>
> 100 menjadi satu nol nol bukan seratus
>
> 1000 menjadi satu nol nol nol bukan seribu
>
> ini untuk merubah nomer hape ke huruf
>
> Gak Pake yang ada Pesen " Telpon Yang anda Tuju Belum Terpasang"
>
> Udah ane bikinin oom........tinggal rubah angka2x yang ada di dalam Cells
> hasil akan keluar berupa angka terbilang dalam bentuk dalam TEXT sesuai
> dengan keinginina oom.........Kodingangannya kayak gini oom :
> - Koding pada This Woorbook :
> Option Explicit
>
> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
> On Error Resume Next
> Dim sHasil As String
> Dim wbSheet As Excel.Worksheet
>
>
> Dim x As String
>
> If Target.Column = 1 Then
>
> Set wbSheet = Sh
> Dim obj As New KelasTerbilang
> sHasil = obj.KonversiAngkaSatuan(Target.Text) ' kall Fungsi yang
> terdapat pada kelas
>
> wbSheet.Cells(Target.Row, 2) = Trim(sHasil) ' perlihatkan hasil
>
> Set wbSheet = Nothing
> End If
> End Sub
>
> - Koding Pada Kelas ( Nama Kelas : KelasTerbilang.cls )
> Option Explicit
>
> Dim Angka(0 To 9) As String
> Dim Angk, txt As String
> Dim n(9) As Integer
> Dim i As Integer
> Dim meValue As String
> Dim x
> Dim jumtxt As Integer
> Dim txtText As String
>
> Private Sub Class_Initialize() ' Kelas Init
> Angka(0) = "Nol"
> Angka(1) = " Satu "
> Angka(2) = " Dua"
> Angka(3) = " Tiga"
> Angka(4) = " Empat"
> Angka(5) = " Lima"
> Angka(6) = " Enam"
> Angka(7) = " Tujuh"
> Angka(8) = " Delapan"
> Angka(9) = " Sembilan"
> End Sub
>
> Public Function KonversiAngkaSatuan(Angk As String) As String
> meValue = "" ' Kosongkan !!! ha ha
>
> jumtxt = Len(Angk) ' Menghitung jumlah Looping
> txtText = Angk
>
> For i = 1 To jumtxt
> x = Mid(txtText, i, 1) ' he he he ;p
> meValue = Angka(x)
> KonversiAngkaSatuan = KonversiAngkaSatuan & " " & meValue ' He he
> ngakalin biar stringnya gak ketiban dan sejajar horizontal ;p Nyarinyee
> ampe 1 jam sendiri
> Next i
>
> End Function
>
>
> Hasilnya dapet di liat di attachment ooom (Makro nya oomm.... jangan Lupa )
>
>
> ~ ^ PUTHUT WIBOWO ^ ~
>
>
>
> --- On Wed, 9/30/09, hadysys <hadisys@pln.co.id> wrote:
>
> From: hadysys <hadisys@pln.co.id>
> Subject: ]] XL-mania [[ konvert dari phone number ke huruf
> To: XL-mania@yahoogroups.com
> Date: Wednesday, September 30, 2009, 4:45 PM
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> suhu minta bantuan
>
> gimana caranya konversi angka ke huruf bukan terbilang loh ya ?
>
>
>
> misal
>
> 100 menjadi satu nol nol bukan seratus
>
> 1000 menjadi satu nol nol nol bukan seribu
>
> ini untuk merubah nomer hape ke huruf
>
>
>
> makasih atas bantuannya
>
>
>
> sys
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

__._,_.___

Messages in this topic (5) Reply (via web post) | Start a new topic

Messages

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Tolong cariin momods kerjaan jadi direktur dongggg... :D :D :D    |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

MARKETPLACE

Mom Power: Discover the community of moms doing more for their families, for the world and for each other