MS Excel Experts??????

[Syed Hamid Ali]

السلام علیکم برادر
میرے دو مسائل ہیں جو کہ ایکسل کی شیٹ میں ہے اگر آپ حل کر دیں تو کیا ہی بات ہے۔ مسئلہ نمبر 1 یہ ہے کہ جب ہم رقم ہندسوں میں لکھتے ہیں تو ساتھ والے سیل میں رقم فارمولا کے ساتھ لفظوں میں لکھی جائے۔
جیسے
Rs.5350/- (Rupees Five Thousand Three Hundred Fifty Only)
اور مسئلہ نمبر 2 یہ ہے کہ کیش میمو جو کہ فائل کے ساتھ اٹیچ ہے جب ایک کیش میمو کا پرنٹ لے لیں تو اگلے کیش میمو کا انوائس نمبر چینج ہو جائے مطلب کہ اپنی کاونٹنگ جاری رکھے۔ بس اتنا ہی باقی انشاء اللہ آپ کی رہنمائی میسر ہوتی رہے گی۔ شکریہ

[Syed Hamid Ali]

برادر میرا پہلا مسئلہ تو گوگل سرچ کرنے سے حل ہو گیا اس کا لنک پیش کر دیتا ہوں تا کہ مزید دوست بھی استفادہ کر سکیں۔ اب میرا دوسرا مسئلہ حل ہونا باقی ہے۔
پہلے مسئلہ جو مجھے درپیش تھا اس کا لنک چیک کریں۔

-----------

مجھے یہاں ایک بات کی سمجھ نہیں آئی وہ یہ کہ اس فارمولا کو زیادہ دیر تک محفوظ کرنے کا کیا طریقہ ہے۔

[ShahbazSuper]

بھائی پہلے مسلے کا حل یہ ہےALT+F11پریس کریں
اور پھرinsert moduleمیں جا کریہ والا کوڈ پیسٹ کریں،

Function SpellNumberToEnglish(ByVal pNumber)
'Updateby20131113
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
xHundred = ""
xValue = Right(pNumber, 3)
If Val(xValue) <> 0 Then
xValue = Right("000" & xValue, 3)
If Mid(xValue, 1, 1) <> "0" Then
xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
End If
If Mid(xValue, 2, 1) <> "0" Then
xHundred = xHundred & GetTens(Mid(xValue, 2))
Else
xHundred = xHundred & GetDigit(Mid(xValue, 3))
End If
End If
If xHundred <> "" Then
Dollars = xHundred & arr(xIndex) & Dollars
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumberToEnglish = Dollars & Cents
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
Select Case Val(pTens)
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
Select Case Val(Left(pTens, 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(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
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

یہ کوڈ بنانے کے بعد واپس آ جائیں ورکشیٹ پے،
وہاں یہ فارمولا پیسٹ کرتے ہوئے استما کر سکتے ہیں،،
اور ہاں یہ ڈالر لکھا ہوا آئے گا، وہ تبدیل کر لینا،
اگر سمجھ نہ آئے تو پوچھ لینا۔

[ShahbazSuper]

بھائی پہلے مسلے کا حل یہ ہےALT+F11پریس کریں
اور پھرinsert moduleمیں جا کریہ والا کوڈ پیسٹ کریں،

Function SpellNumberToEnglish(ByVal pNumber)
'Updateby20131113
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
xHundred = ""
xValue = Right(pNumber, 3)
If Val(xValue) <> 0 Then
xValue = Right("000" & xValue, 3)
If Mid(xValue, 1, 1) <> "0" Then
xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
End If
If Mid(xValue, 2, 1) <> "0" Then
xHundred = xHundred & GetTens(Mid(xValue, 2))
Else
xHundred = xHundred & GetDigit(Mid(xValue, 3))
End If
End If
If xHundred <> "" Then
Dollars = xHundred & arr(xIndex) & Dollars
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumberToEnglish = Dollars & Cents
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
Select Case Val(pTens)
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
Select Case Val(Left(pTens, 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(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
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

یہ کوڈ بنانے کے بعد واپس آ جائیں ورکشیٹ پے،
وہاں یہ فارمولا پیسٹ کرتے ہوئے استما کر سکتے ہیں،،
اور ہاں یہ ڈالر لکھا ہوا آئے گا، وہ تبدیل کر لینا،
اگر سمجھ نہ آئے تو پوچھ لینا۔

یہ لو بھائی وہ ڈالر والا مسلہ بھی حل کر دیا ہے
مزید کچھ؟

Function SpellNumberToEnglish(ByVal pNumber)
'Updateby20131113
Dim Rupees, paises
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
paises = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
xHundred = ""
xValue = Right(pNumber, 3)
If Val(xValue) <> 0 Then
xValue = Right("000" & xValue, 3)
If Mid(xValue, 1, 1) <> "0" Then
xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
End If
If Mid(xValue, 2, 1) <> "0" Then
xHundred = xHundred & GetTens(Mid(xValue, 2))
Else
xHundred = xHundred & GetDigit(Mid(xValue, 3))
End If
End If
If xHundred <> "" Then
Rupees = xHundred & arr(xIndex) & Rupees
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
Select Case Rupees
Case ""
Rupees = "No Rupees"
Case "One"
Rupees = "One Rupee"
Case Else
Rupees = Rupees & " Rupees"
End Select
Select Case paises
Case ""
paises = " and No paises"
Case "One"
paises = " and One paisa"
Case Else
paises = " and " & paises & " paises"
End Select
SpellNumberToEnglish = Rupees & paises
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
Select Case Val(pTens)
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
Select Case Val(Left(pTens, 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(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
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

[Syed Hamid Ali]

Brother mera dosra masla bhi hal krain thanks

[Syed Hamid Ali]

Thanks Brother. mera dosra masla hall krain. please

[Fatima Iqbal]

آپ جو ویب سائٹ لنک دے رہیں ہیں وہ الاؤ نہیں ہے

برادر میرا پہلا مسئلہ تو گوگل سرچ کرنے سے حل ہو گیا اس کا لنک پیش کر دیتا ہوں تا کہ مزید دوست بھی استفادہ کر سکیں۔ اب میرا دوسرا مسئلہ حل ہونا باقی ہے۔
پہلے مسئلہ جو مجھے درپیش تھا اس کا لنک چیک کریں۔

-----------

مجھے یہاں ایک بات کی سمجھ نہیں آئی وہ یہ کہ اس فارمولا کو زیادہ دیر تک محفوظ کرنے کا کیا طریقہ ہے۔

[ShahbazSuper]

دوسرا مسلہ میری سمجھ میں ہی نہین آیا۔۔۔۔۔

[ShahbazSuper]

آپ مثالی شیٹ بھیجو میں حل ڈھونڈ دوں گا،، پہلے والی کی سمجھ آ گئی تھی کیا؟

[Syed Hamid Ali]

Ji han Samajh aa gai thi. 2sra masla ye tha ko 1 cash memo hy jb ham shop per cash memo ka print lyty hain thw us per searal number likha hota hy. ma chahta ye hon k jb next print loon thw cash memo per automatic searal number change ho jaye. thanks

[ShahbazSuper]

to aap koi sheet memo bhi send karo ta k mein us ka hal nikal sakoun.....

[ShahbazSuper]

ji mila farmula ya bna doun?