Jumat, 30 Mei 2008

Script Konversi Angka ke Terbilang

pemakaian script ini bisa dilihat pada
http://omanscripts.blogspot.com/2008/05/terbilang-angka.html


===begin of script===
Option Explicit
'Main Function
Function
Terbilang(ByVal MyNumber)
Dim Dollars, Cents,
Temp
Dim DecimalPlace, Count
Dim
bilangan
ReDim Place(9) As String

Place(2) = " Ribu "
Place(3) = " Juta
"
Place(4) = " Milyar "
Place(5) = "
Triliun "
' String representation of
amount.
MyNumber =
Trim(Str(MyNumber))
' Position of decimal place 0 if
none.
DecimalPlace = InStr(MyNumber,
".")
' Convert cents and set MyNumber to dollar
amount.
If DecimalPlace > 0
Then
Cents =
GetTens(Left(Mid(MyNumber, DecimalPlace + 1) &
_

"00", 2))
MyNumber =
Trim(Left(MyNumber, DecimalPlace - 1))
End
If
Count = 1
Do While MyNumber
<> ""
Temp =
GetHundreds(Right(MyNumber, 3))

bilangan = Temp & Place(Count)

If bilangan = "Satu Ribu " Then bilangan = "Seribu
"
If Temp <> "" Then Dollars
= bilangan & Dollars
If
Len(MyNumber) > 3
Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""
End
If
Count = Count +
1
Loop
Select Case
Dollars
Case
""
Dollars
= "Rupiah"
Case
"One"

Dollars = "Satu Rupiah"
Case
Else

Dollars = Dollars & " Rupiah"
End
Select
Select Case
Cents
Case
""
Cents =
""
Case
"One"

Cents = " and One
Cent"

Case Else

Cents = " Koma " & Cents
End
Select
Terbilang = Dollars & Cents
End
Function

' Converts a number from 100-999
into text
Function GetHundreds(ByVal MyNumber)
Dim
Result As String
If Val(MyNumber) = 0 Then Exit
Function
MyNumber = Right("000" & MyNumber,
3)
' Convert the hundreds place.
If
Mid(MyNumber, 1, 1) = "1" Then

Result = "Seratus "
ElseIf Mid(MyNumber, 1, 1) <>
"0" Then
Result =
GetDigit(Mid(MyNumber, 1, 1)) & " Ratus "
End
If
' Convert the tens and ones
place.
If Mid(MyNumber, 2, 1) <> "0"
Then
Result = Result &
GetTens(Mid(MyNumber, 2))

Else
Result = Result &
GetDigit(Mid(MyNumber, 3))
End If

GetHundreds = Result
End Function

'
Converts a number from 10 to 99 into text.
Function
GetTens(TensText)
Dim Result As
String
Result =
"" ' Null out the
temporary function value.
If Val(Left(TensText, 1)) = 1
Then ' If value between
10-19...
Select Case
Val(TensText)

Case 10: Result =
"Sepuluh"

Case 11: Result =
"Sebelas"

Case 12: Result = "Dua
Belas"

Case 13: Result = "Tiga
Belas"

Case 14: Result = "Empat
Belas"

Case 15: Result = "Lima
Belas"

Case 16: Result = "Enam
Belas"

Case 17: Result = "Tujuh
Belas"

Case 18: Result = "Delapan
Belas"

Case 19: Result = "Sembilan
Belas"

Case Else
End
Select

Else
' If value between 20-99...
Select
Case Val(Left(TensText,
1))
Case
2: Result = "Dua Puluh
"
Case 3:
Result = "Tiga Puluh
"
Case 4:
Result = "Empat Puluh
"
Case 5:
Result = "Lima Puluh
"
Case 6:
Result = "Enam Puluh
"
Case 7:
Result = "Tujuh Puluh
"
Case 8:
Result = "Delapan Puluh
"
Case 9:
Result = "Sembilan Puluh
"
Case
Else
End
Select
Result = Result &
GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.
End
If
GetTens = Result
End
Function

' Converts a number from 1 to 9 into
text.
Function GetDigit(Digit)
Select Case
Val(Digit)
Case 1: GetDigit =
"Satu"
Case 2: GetDigit =
"Dua"
Case 3: GetDigit =
"Tiga"
Case 4: GetDigit =
"Empat"
Case 5: GetDigit =
"Lima"
Case 6: GetDigit =
"Enam"
Case 7: GetDigit =
"Tujuh"
Case 8: GetDigit =
"Delapan"
Case 9: GetDigit =
"Sembilan"
Case Else: GetDigit =
""
End Select
End Function


===begin of script===

Terbilang Angka

dari http://support.microsoft.com/kb/213360 (How to convert a numeric value into English words in Excel),
script yang sudah saya modifikasi menjadi bahasa indonesia bisa di lihat di
http://omanscripts.blogspot.com/2008/05/script-konversi-angka-ke-terbilang.html
ada beberapa cara menggunakannya:

1. Disimpan dalam makro, dipaste ke vba setiap file excel


copy script tersebut,
klik tools - macro - visual basic editor,
pada visual basic editor, klik insert - module,
paste script yang dicopy tadi,
tutup visual basic editor dengan mengklik File - close and return to excel.
coba gunakan function yang sudah dibuat seperti menggunakan function excel biasa:

misal:

  • cell(A1) diisi "124",
  • cell(A2) isi "=terbilang(A1)" tanpa kutip
note: setiap akan menggunakan function tersebut, lakukan semua step dari awal.

2. Dijadikan add-ins, yang bisa dipanggil kapan saja dalam setiap file excel.

lakukan step 1 pada file excel baru,
klik File - Save as...
simpan pada direktori "c:\windows\addins"
beri nama apa saja dengan File Type: "Microsoft Excel add-in"

note:
setiap akan menggunakan add-ins tersebut:
klik Tools - addins - checklist pada addins "terbilang" atau sesuai nama file add-ins yang telah disimpan.

Senin, 14 April 2008

Mengambil Informasi Sistem Operasi


strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery ("SELECT * FROM Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
Wscript.Echo objOperatingSystem.Caption, objOperatingSystem.Version
Next


strComputer = "." => ini berarti komputer target adalah lokal, silakan ganti "." dengan nama komputer yang akan dicek.

Menampilkan jam lokal

script ini untuk mengambil dan menampilkan jam lokal komputer.


Set objWMIService = GetObject("winmgmts:")
Set colItems = objWMIService.InstancesOf("Win32_LocalTime")
For Each objItem in colItems
tMin = right("0" & objItem.Minute,2)
tSec = right("0" & objItem.Second,2)
DateTime = objItem.Month & "/" & objItem.Day & "/" & objItem.Year & " - " & objItem.Hour & ":" & tMin & ":" & tSec
Next
wscript.echo DateTime



Berikut adalah penjelasan dari tiap barisnya:

Set objWMIService = GetObject("winmgmts:")

ini adalah koneksi ke objek yang akan diambil.
jika tanpa alamat maka objek diambil dari komputer lokal.
untuk koneksi ke komputer lain, tambahkan alamat setelah ":", misal: "winmgmts:\\pc-01" maka objek diambil dari pc-01.
koneksi ini bisa menggunakan IP address ataupun DNS.
lengkapnya tentang WMI Object, silakan lihat di http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_llee.mspx?mfr=true



Set colItems = objWMIService.InstancesOf("Win32_LocalTime")

baris ini untuk mengambil koleksi dari instansi LocalTime komputer.


For Each objItem in colItems
tMin = right("0" & objItem.Minute,2)
tSec = right("0" & objItem.Second,2)
DateTime = objItem.Month & "/" & objItem.Day & "/" & objItem.Year & " - " & objItem.Hour & ":" & tMin & ":" & tSec
Next

bagian ini adalah untuk mengambil tanggal dan jam dari komputer.


wscript.echo DateTime

Tampilkan hasilnya.