নির্বাচিত পোস্ট | লগইন | রেজিস্ট্রেশন করুন | রিফ্রেস

আমি মানুষ হওয়ার জন্য চেষ্টা করছি!!

সোনারতরী

আমি একজন সাধারন মানুষ

সোনারতরী › বিস্তারিত পোস্টঃ

টাকা ইন ওয়ার্ড (Taka In Word ) In Ms Excel এ কিভাবে Automatic পাবেন ???

২৭ শে মার্চ, ২০১০ রাত ১১:২০

এই টা আমার ২য় ব্লগ , আশা করি আপনার কাজে আসতে পারে। আপনি আগে কোন সংখ্যাকে টাইপ করে তার কথায় লিখতেন যেমন : 555 (in Word:Taka Five Hundred Fifty Five Only) কিন্তু এখন আপনি Ms Excel Automatic পাবেন টাইপ করার প্রয়োজন নেই : আপনার যোগফল যাই হোক না কেন Automatic অন্য একটা Cell a তা দেখতে পাবেন:





( মনে রাখবেন এইটা শুধু ১(এক) থেকে ৯৯ কোটি টাক পর্যন্ত হবে)



কিভাবে করবেন :





প্রথমে একটু ইতিহাস : এইটা আমার দ্বারা তৈরি হয়নি , আর আমিও এখন বলতে পারবনা এইটা কার দ্বারা সৃষ্টি হয়েছে।কারন এইটা সম্ভবত প্রথমে ছিল ডলারে তারপর রুপিতে এখন আমি টাকাতে করার চেষ্টা করছি মাত্র। তবে এইটুকু বলতে পারি যে রুপিতে লিখেছে তার নাম (Bhasker Kumar)।





তাহলে শুরু করা যাক: এইটা শুধু মাত্র Ms Excel . XP ,2002, 2003 এর জন্য। (2007 এর জন্য পরে একটি ব্লগ লিখার চেষ্টা করব। )



প্রথমে আপনি :

১.Tools menu, point to Macro, and then click Security Tab





নিচের ছবিটি ভাল কর দেখুন:





২.And Then Security Level Tab এ সবার নীচে Low (Not Recommended) You are not Protected …………Click করে OK করুন





এবার আপনি নতুন একটা ফাইল Create করুন, তারপর আপনি Alt+F11 press করে Microsoft Visual Basic open করুন।



এবার Microsoft Visual Basic এর Insert menu point to Module Click করুন।



Module ওপেন হবার পর নীচের কোড গুলো কপি করে save করুন।

-------------------------------

Function rubeltaka(ByVal MyNumber)

Dim Taka, Paisa, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Lac "

Place(4) = " Crore "

Place(5) = " Arab " ' String representation of amount

MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none

DecimalPlace = InStr(MyNumber, ".")

' Convert Paisa and set MyNumber to Taka amount

If DecimalPlace > 0 Then

Paisa = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

If Count = 1 Then Temp = GetHundreds(Right(MyNumber, 3))

If Count > 1 Then Temp = GetHundreds(Right(MyNumber, 2))

If Temp <> "" Then Taka = Temp & Place(Count) & Taka

If Count = 1 And Len(MyNumber) > 3 Then

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

Else

If Count > 1 And Len(MyNumber) > 2 Then

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

Else

MyNumber = ""

End If

End If

Count = Count + 1

Loop

Select Case Taka

Case ""

Taka = "No Taka"

Case "One"

Taka = "One Taka"

Case Else

'Taka = Taka & " Taka"

Taka = "Taka " & Taka

End Select

Select Case Paisa

Case ""

'Paisa = ""

Paisa = " Only"

Case "One"

Paisa = " and One Paisa"

Case Else

Paisa = " and " & Paisa & " Paisa"

End Select

rubeltaka = Taka & Paisa

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) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

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 = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

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 = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function







---------------------





আপনার সুবিধার জন্য নীচের লিংক থেকে ফইল টি নিয়ে নিতে পারেন।



Click This Link





you can insert it from the Function Options or just enter the following command in the desired cell where you want the result:



=rubeltaka(Cell Referenc)



ও মনে রাখবেন এইটা শুধু এই File এর ভিতরে কাজ করবে । আন্য কোন File এ কাজ করবে না । তাই যত খুশি আপনি কপি করেন অথবা যত খুশি Sheet তৈরি করে কাজ করুন ।



এইটা সময় এর জন্য সুন্দর করতে পারি নাই , সময় পেলে আরও সুন্দর করার চেষ্টা করব। আর ২০০৭ এর জন্য নতুন আরেকটি ব্লগ লিখব আশ করি।

ছবি গুলো ঠিক করে দিতে পারি নাই।





মন্তব্য ৬ টি রেটিং +৫/-০

মন্তব্য (৬) মন্তব্য লিখুন

১| ১২ ই এপ্রিল, ২০১০ দুপুর ১২:২২

হিটলারের সাগরেদ বলেছেন: আমি একজন সাধারন মানু


আমি মানুষ হওয়ার জন্য চেষ্টা করছি!!

১৩ ই এপ্রিল, ২০১০ সকাল ১১:০৪

সোনারতরী বলেছেন: ভাই আমি বুঝতে পরলাম না। এইটার মানে কি...../?

২| ১৪ ই এপ্রিল, ২০১০ দুপুর ২:৫৫

নস্টালজিক বলেছেন: শুভ নববর্ষ।।

লিখতে থাকেন।।

ব্লগে স্বাগত জানাই।।

১৭ ই এপ্রিল, ২০১০ সকাল ১০:০৪

সোনারতরী বলেছেন: ধন্যবাদ ভাই ,,

৩| ১৮ ই এপ্রিল, ২০১০ রাত ৩:৪৩

সাগর রহমান বলেছেন: ব্লগে স্বাগতম।।+

১৮ ই এপ্রিল, ২০১০ সকাল ১০:১৮

সোনারতরী বলেছেন: ধন্যবাদ ভাই,

আপনার মন্তব্য লিখুনঃ

মন্তব্য করতে লগ ইন করুন

আলোচিত ব্লগ


full version

©somewhere in net ltd.