تبدیل فونت داس به ویندوز

[shima2006]

سلام
من توی فاکس پرو (تحت داس) مقدار زیادی اطلاعات به زبونه فارسی دارم که باید اونها رو به اکسل منتقل کنم ولی مشکل اینجاست که وقتی اطلاعات رو به اکسل انتقال میدم واژه های فارسی دیگه قابل خوندن نیستن
برای تبدیل فونت فارسی داس به ویندوز مطالبی توی همین سایت بود که به دردم نخورد!!!راستی این فایل dbf است اگه ممکنه من رو یک راهنمایی بکنید
متشکرم

[kia1349]

چرا به دردت نخورد.همه دارن ازش استفاده میکنن.حتما اشکالی در کار خودتان وجود دارد

[shima2006]

متشکرم
میشه فایلشو برام بفرستید
shimakhalili65@yahoo.com

datamanager.exe من این فایل رو دانلود کردم ولی تمام فونتهای برنامه غیرقابل خوندن بود

[shima2006]

ببخشید میشه لطف کنید این برنامه رو امروز برای من بفرستید ؟؟؟
آخه من امروز باید این کار رو انجام بدم و برای مدیرم بفرستم
ممنون میشم اگه برنامتون رو برام بفرستید

[shima2006]

سلام
اون برنامه ای رو که( datamanager )گفتم با فونتش مشکل دارم مشکلش برطرف شد و تونستم اطلاعات رو به اکسل ببرم
ازتون ممنونم

[a_maisami]

Sub TOwin()
Dim map(255) As Integer
Dim myString As String
Dim myChar As String * 1
For i = 0 To 255
map(i) = i
Next
map(128) = 48: map(129) = 49: map(130) = 50: map(131) = 51:
map(132) = 52: map(133) = 53: map(134) = 54: map(135) = 55:
map(136) = 56: map(137) = 57: map(138) = 161: map(139) = 45:
map(140) = 191: map(141) = 194: map(142) = 198: map(143) = 193:
map(144) = 199: map(145) = 199: map(146) = 200: map(147) = 200:
map(148) = 129: map(149) = 129: map(150) = 202: map(151) = 202:
map(152) = 203: map(153) = 203: map(154) = 204: map(155) = 204:
map(156) = 141: map(157) = 141: map(158) = 205: map(159) = 205:
map(160) = 206: map(161) = 206: map(162) = 207: map(163) = 208:
map(164) = 209: map(165) = 210: map(166) = 142: map(167) = 211:
map(168) = 211: map(169) = 212: map(170) = 212: map(171) = 213:
map(172) = 213: map(173) = 214: map(174) = 214: map(175) = 216:
map(224) = 217: map(225) = 218: map(226) = 218: map(227) = 218:
map(228) = 218: map(229) = 219: map(230) = 219: map(231) = 219:
map(232) = 219: map(233) = 221: map(234) = 221: map(235) = 222:
map(236) = 222: map(237) = 223: map(238) = 223: map(239) = 144:
map(240) = 144: map(241) = 225: map(243) = 225: map(244) = 227:
map(245) = 227: map(246) = 228: map(247) = 228: map(248) = 230:
map(249) = 229: map(250) = 229: map(251) = 229: map(252) = 237:
map(253) = 237: map(254) = 237:

For Each c In Selection
If c.Value <> "" Then
myString = c.Value
temp = ""
endi = Len(myString)
h:
For i = endi To 1 Step -1
myChar = Chr(map(Asc(Mid(myString, i, 1))))
If (myChar = "0") Or (myChar = "1") Or (myChar = "2") Or (myChar = "3") Or (myChar = "4") Or (myChar = "5") Or (myChar = "6") Or (myChar = "7") Or (myChar = "8") Or (myChar = "9") Then
starti = i
flag = True
Do
i = i - 1
If i > 0 Then myChar = Chr(map(Asc(Mid(myString, i, 1))))
Loop Until (i < 1) Or ((myChar <> "0") And (myChar <> "1") And (myChar <> "2") And (myChar <> "3") And (myChar <> "4") And (myChar <> "5") And (myChar <> "6") And (myChar <> "7") And (myChar <> "8") And (myChar <> "9"))
endi = i + 1
Exit For
End If
temp = temp + myChar
Next
If flag Then
For i = endi To starti Step 1
myChar = Chr(map(Asc(Mid(myString, i, 1))))
temp = temp + myChar
Next
endi = endi - 1
flag = False
GoTo h:
End If
c.FormulaR1C1 = temp
End If
Next
End Sub
Sub TOdos()
'Cells(1, 1).Value = Chr(245) + Chr(254) + Chr(153) + Chr(245) + Chr(252) 'ãíËãí
'Cells(1, 1).Value = Chr(245) + Chr(159) + Chr(245) + Chr(162) 'ãÍãÏ
'Cells(1, 1).Value = Chr(245) + Chr(246) ãä
'Cells(1, 1).Value = Chr(169) + Chr(170)

Dim map(255) As Integer
Dim myString As String
Dim myChar As String * 1

For i = 0 To 255
map(i) = i
Next

map(161) = 138:
map(191) = 140:
map(194) = 141: 'Â
map(198) = 142:
map(193) = 143:

map(207) = 162: 'Ï
map(208) = 163:
map(209) = 164:
map(210) = 165:
map(142) = 166:
map(216) = 175:
map(217) = 224:
map(230) = 248:

'Ç tanha chasban
map(199) = 144: map(199) = 145:
'È akhar avval
map(200) = 146: map(200) = 147:
' akhar avval
map(129) = 148: map(129) = 149:
'Ê akhar avval
map(202) = 150: map(202) = 151:
'Ë akhar avval
map(203) = 152: map(203) = 153:
'Ì akhar avval
map(204) = 154: map(204) = 155:
' akhar avval
map(141) = 156: map(141) = 157:
'Í akhar avval
map(205) = 158: map(205) = 159:
'Î akhar avval
map(206) = 160: map(206) = 161:
'Ó akhar avval
map(211) = 167: map(211) = 168:
'Ô akhar avval
map(212) = 169: map(212) = 170:
'Õ akhar avval
map(213) = 171: map(213) = 172:
'Ö akhar avval
map(214) = 173: map(214) = 174:
'Ý akhar avval
map(221) = 233: map(221) = 234:
'Þ akhar avval
map(222) = 235: map(222) = 236:
'ß akhar avval
map(223) = 237: map(223) = 238:
' akhar avval
map(144) = 239: map(144) = 240:
'á akhar avval
map(225) = 241: map(225) = 243:
'ã akhar avval
map(227) = 244: map(227) = 245:
'ä akhar avval
map(228) = 246: map(228) = 247:

'å tanha vasat avval
map(229) = 249: map(229) = 250: map(229) = 251:
'í chasban akhar tanha vasat
map(237) = 252: map(237) = 253: map(237) = 254:

'Ú akhar tanha akhar chasban vasat avval
map(218) = 225: map(218) = 226: map(218) = 227: map(218) = 228:
'Û akhar tanha akhar chasban vasat avval
map(219) = 229: map(219) = 230: map(219) = 231: map(219) = 232:

For Each c In Selection
If c.Value <> "" Then
myString = c.Value
temp = ""
endi = Len(myString)
h:
For i = endi To 1 Step -1

If i <> 1 Then harfe_ghabl = Mid(myString, i - 1, 1) Else harfe_ghabl = ""
If i <> Len(myString) Then harfe_baade = Mid(myString, i + 1, 1) Else harfe_baade = ""
harfe_jaree = Mid(myString, i, 1)

'################################################# #######################
If harfe_jaree = "Ç" Then
If harfe_ghabl = " " Or harfe_ghabl = "" Or InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(199) = 144:
Else
map(199) = 145:
End If
End If
'################################################# #######################
If harfe_jaree = "È" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(200) = 146:
Else
map(200) = 147:
End If
End If
'################################################# #######################
If harfe_jaree = "" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(129) = 148:
Else
map(129) = 149:
End If
End If
'################################################# #######################
If harfe_jaree = "Ê" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(202) = 150:
Else
map(202) = 151:
End If
End If
'################################################# #######################
If harfe_jaree = "Ë" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(203) = 152:
Else
map(203) = 153:
End If
End If
'################################################# #######################
If harfe_jaree = "Ì" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(204) = 154:
Else
map(204) = 155:
End If
End If
'################################################# #######################
If harfe_jaree = "" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(141) = 156:
Else
map(141) = 157:
End If
End If
'################################################# #######################
If harfe_jaree = "Í" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(205) = 158:
Else
map(205) = 159:
End If
End If
'################################################# #######################
If harfe_jaree = "Î" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(206) = 160:
Else
map(206) = 161:
End If
End If
'################################################# #######################
If harfe_jaree = "Ó" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(211) = 167:
Else
map(211) = 168:
End If
End If
'################################################# #######################
If harfe_jaree = "Ô" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(212) = 169:
Else
map(212) = 170:
End If
End If
'################################################# #######################
If harfe_jaree = "Õ" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(213) = 171:
Else
map(213) = 172:
End If
End If
'################################################# #######################
If harfe_jaree = "Ö" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(214) = 173:
Else
map(214) = 174: '============>> EXCEPTION
End If
End If
'################################################# #######################
If harfe_jaree = "Ý" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(221) = 233:
Else
map(221) = 234:
End If
End If
'################################################# #######################
If harfe_jaree = "Þ" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(222) = 235:
Else
map(222) = 236:
End If
End If
'################################################# #######################
'æä Ïæ ÊÇ ß ÈÇ ßρíÌ ãÎÊáÝ ÏÑ æíäÏæÒ ÏÇÑíã
If (harfe_jaree = "ß") Then
If harfe_baade = " " Or harfe_baade = "" Then
map(223) = 237:
Else
map(223) = 238:
End If
End If
'################################################# #######################
'æä Ïæ ÊÇ ß ÈÇ ßρíÌ ãÎÊáÝ ÏÑ æíäÏæÒ ÏÇÑíã
If (Asc(harfe_jaree) = 152) Then
If harfe_baade = " " Or harfe_baade = "" Then
map(152) = 237:
Else
map(152) = 238:
End If
End If
'################################################# #######################
If harfe_jaree = "" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(144) = 239:
Else
map(144) = 240:
End If
End If
'################################################# #######################
If harfe_jaree = "á" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(225) = 241:
Else
map(225) = 243:
End If
End If
'################################################# #######################
If harfe_jaree = "ã" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(227) = 244:
Else
map(227) = 245:
End If
End If
'################################################# #######################
If harfe_jaree = "ä" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(228) = 246:
Else
map(228) = 247:
End If
End If
'################################################# #######################
If harfe_jaree = "å" Then
If harfe_baade = " " Or harfe_baade = "" Then
map(229) = 249:
Else
If harfe_ghabl = " " Or harfe_ghabl = "" Or InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(229) = 251:
Else
map(229) = 250:
End If
End If
End If
'################################################# #######################
If harfe_jaree = "í" Then
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(237) = 253:
Else
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) = 0 Then
map(237) = 252:
Else
map(237) = 254:
End If
End If
End If
'################################################# #######################
If harfe_jaree = "Ú" Then
If (harfe_ghabl = " " Or harfe_ghabl = "") Or InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(218) = 228: ' ÚÑÈ
' MsgBox "Test"
Else
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(218) = 225: ' ÇÊÈÇÚ
Else
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) = 0 Then
map(218) = 226: ' ãÑÈÚ
Else
map(218) = 227: ' ãÚÈÑ
End If
End If
End If
End If
'################################################# #######################
If harfe_jaree = "Û" Then
If (harfe_ghabl = " " Or harfe_ghabl = "") Or InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(219) = 232: ' ÛÑÈ
Else
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) > 0 Then
map(219) = 229: ' ÈÇÛ
Else
If (harfe_baade = " " Or harfe_baade = "") And InStr(1, "ÏÐÑÒŽÇÂæ", harfe_ghabl, vbTextCompare) = 0 Then
map(219) = 230: ' ÕíÛ
Else
map(219) = 231: ' ãÛÑÈ
End If
End If
End If
End If
'################################################# #######################
myChar = Chr(map(Asc(Mid(myString, i, 1))))
If (myChar = "0") Or (myChar = "1") Or (myChar = "2") Or (myChar = "3") Or (myChar = "4") Or (myChar = "5") Or (myChar = "6") Or (myChar = "7") Or (myChar = "8") Or (myChar = "9") Then
starti = i
flag = True
Do
i = i - 1
If i > 0 Then myChar = Chr(map(Asc(Mid(myString, i, 1))))
Loop Until (i < 1) Or ((myChar <> "0") And (myChar <> "1") And (myChar <> "2") And (myChar <> "3") And (myChar <> "4") And (myChar <> "5") And (myChar <> "6") And (myChar <> "7") And (myChar <> "8") And (myChar <> "9"))
endi = i + 1
Exit For
End If
temp = temp + myChar
Next
If flag Then
For i = endi To starti Step 1
myChar = Chr(map(Asc(Mid(myString, i, 1))))
temp = temp + myChar
Next
endi = endi - 1
flag = False
GoTo h:
End If
c.FormulaR1C1 = temp
End If
Next
End Sub

Function myFill(myString As String, myMaxLen As Integer, myChar As String, myType As Integer) As String
'myType ===> 0=Ebteda 1=Enteha
If Len(myString) > myMaxLen Then
myString = ReverseString(Mid(ReverseString(myString), 1, myMaxLen))
End If
If ((Len(myString) < myMaxLen) Or (myString = "")) And myType = 1 Then
For i = 1 To myMaxLen - Len(myString) Step 1
myString = myString & myChar
Next
Else
For i = 1 To myMaxLen - Len(myString) Step 1
myString = myChar & myString
Next
End If
myFill = myString
End Function

Public Function ReverseString(ByVal InputString As String) As String

Dim lLen As Long, lCtr As Long
Dim sChar As String
Dim sAns As String

lLen = Len(InputString)
For lCtr = lLen To 1 Step -1
sChar = Mid(InputString, lCtr, 1)
sAns = sAns & sChar
Next

ReverseString = sAns

End Function