module1.bas

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

Attribute VB_Name = "Module1"
Global LB As String
Global OP_name As String
Global ni As String
Global yue As String
Global ri As String
Global Conn_Str As String
Global DB As Adodb.Connection
Global i, N As Integer
Global c_gsmc As String
Global E_gsm As String
Global C_DizH As String
Global E_dizh As String
Global gs_dh As String
Global gs_cz As String
Global intn As Integer
Global ntn As Integer
Global ntnn As Integer
Global nindex As Integer
Global bh As String
Global bhx As String
Global sh As String
Global Del_Right As Boolean
Global Mod_Right As Boolean
Global SH_Right As Boolean
Global Sumsl As Recordset
Global Gszl As Recordset
Global CX_FrM_SjY As Adodc
Global CX_SJy, CX_zD1, Cx_Zd2, CX_z1, Cx_Z2 As String
Global ZF_wZ As Integer
Sub Main()
    Call link_data
    Set Gszl = New Recordset
    Gszl.Open "select * from sys_gsmc", DB, adOpenStatic
    If Gszl.RecordCount > 0 Then
     Gszl.MoveFirst
     c_gsmc = Gszl!gsmc
     E_gsm = Gszl!E_gsmc
     C_DizH = Gszl!gsdz
     E_dizh = Gszl!e_gsdz
     gs_dh = Gszl!gs_phone
     gs_cz = Gszl!gs_fax
    End If
    For i = 1 To 10000
    For N = 1 To 1000
    Next N
    Next i
   Load main_FRM
   Unload frmSplash
   main_FRM.Show
   Dim fLogin As New frmLogin
   fLogin.Show vbModal
End Sub
Sub link_data() '连接数据源
Dim fLogin As New frmLogin
frmSplash.Show
frmSplash.Refresh
On Error Resume Next
Dim data_link1 As Adodb.Connection
Dim data_link_recordset As Adodb.Recordset
Dim link_str As String
Dim link_source As String
Dim c_str As String
Dim p1 As String
Dim u1 As String
Dim ds As String
Dim das As String
Dim path As String
link_str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\data_link.mdb;Persist Security Info=False"
Set data_link1 = New Adodb.Connection
data_link1.Open link_str
Set data_link_recordset = New Adodb.Recordset
data_link_recordset.Open "select * from data_link", data_link1, adOpenStatic, adLockOptimistic
data_link_recordset.MoveFirst
With data_link_recordset
    p1 = Trim(.Fields("Password"))
    u1 = Trim(.Fields("UserID"))
    ds = Trim(.Fields("datasource"))
    das = Trim(.Fields("Database"))
End With
Conn_Str = "Provider=SQLOLEDB.1;Persist Security Info=True;password=" & p1 & ";User ID=" & u1 & ";Initial Catalog=" & das & ";Data Source=" & ds & ""
Set DB = New Adodb.Connection
DB.CursorLocation = adUseClient
DB.Open Conn_Str
If Err = 94 Then
Exit Sub
Else
MsgBox "服务器置有问题,点确认,设置.", 48, "系统提示"
Unload frmSplash
Load frmODBCLogon
frmODBCLogon.Show vbModal
End
End If
End Sub


Public Function zr4(Y) '准备数据 曹汉华 数字金额转换为英文大写金额函数 2003年10月9日（16位）
Dim z(10)
z(1) = "ONE"
z(2) = "TWO"
z(3) = "THREE"
z(4) = "FOUR"
z(5) = "FIVE"
z(6) = "SIX"
z(7) = "SEVEN"
z(8) = "EIGHT"
z(9) = "NINE"
zr4 = z(Mid(Y, 1, 1))
End Function

Public Function zr3(Y) '准备数据
Dim z(10)
z(1) = "ONE"
z(2) = "TWO"
z(3) = "THREE"
z(4) = "FOUR"
z(5) = "FIVE"
z(6) = "SIX"
z(7) = "SEVEN"
z(8) = "EIGHT"
z(9) = "NINE"
zr3 = z(Mid(Y, 3, 1))
End Function


Public Function zr2(Y) '准备数据

Dim z(20)
z(10) = "TEN"
z(11) = "ELEVEN"
z(12) = "TWELVE"
z(13) = "THIRTEEN"
z(14) = "FOURTEEN"
z(15) = "FIFTEEN"
z(16) = "SIXTEEN"
z(17) = "SEVENTEEN"
z(18) = "EIGHTEEN"
z(19) = "NINETEEN"
zr2 = z(Mid(Y, 2, 2))

End Function

Public Function zr1(Y) '准备数据

Dim z(10)
z(1) = "TEN"
z(2) = "TWENTY"
z(3) = "THIRTY"
z(4) = "FORTY"
z(5) = "FIFTY"
z(6) = "SIXTY"
z(7) = "SEVENTY"
z(8) = "EIGHTY"
z(9) = "NINETY"
zr1 = z(Mid(Y, 2, 1))

End Function


Public Function dw(Y) '准备数据

Dim z(5)
z(0) = ""
z(1) = "THOUSAND"
z(2) = "MILLION"
z(3) = "BILLION"
dw = z(Y)

End Function

Public Function w2(Y) '用来制作2位数字转英文
    
If Mid(Y, 2, 1) = "0" Then '判断是否小于十
    Value = zr3(Y)
ElseIf Mid(Y, 2, 1) = "1" Then '判断是否在十到二十之间
    Value = zr2(Y)
ElseIf Mid(Y, 3, 1) = "0" Then '判断是否为大于二十小于一百的能被十整除的数（为了去掉尾空格）
    Value = zr1(Y)
Else
    Value = zr1(Y) + " " + zr3(Y) '加上十位到个位的空格
End If
w2 = Value
End Function

Function w3(Y) '用来制作3位数字转英文
If Mid(Y, 1, 1) = "0" Then '判断是否小于一百
    Value = w2(Y)
ElseIf Mid(Y, 2, 2) = "00" Then '判断是否能被一百整除
    Value = zr4(Y) + " " + "HUNDRED"
Else
    Value = zr4(Y) + " " + "HUNDRED" + " " + "AND" + " " + w2(Y) '不能整除的要后面加“AND”
End If
w3 = Value
End Function

Public Function Ywje(X As String)
X = Trim(Str(Round(Val(X), 2)))
If Len(X) > 15 Then
MsgBox "位数超过16位，计算溢出！", vbOKOnly + 16, "系统提示"

End If
z = InStr(1, X, ".", 1) '取小数点位置
If z <> 0 Then '判断有没有小数
lstr = Mid(X, 1, z - 1) '取小数点左边的字串
rstr = Mid(X, z + 1, 2) '取小数点右边的字串
Else
lstr = X '没有小数的情况
End If
lstrev = StrReverse(lstr) '对左边的字串取反字串
Dim a(5) '定义5个字串变量用来存放解析出的三位一组的字串
Select Case Len(lstrev) Mod 3 '字串长度不能被整除，需补齐
    Case "1"
        lstrev = lstrev + "00"
    Case "2"
        lstrev = lstrev + "0"
End Select
lm = "" '用来存放转换后的整数部分
For i = 0 To Len(lstrev) / 3 - 1 '计算有多少个三位
    a(i) = StrReverse(Mid(lstrev, 3 * i + 1, 3)) '截取第1个三位
    If a(i) <> "000" Then '用来避免这种情况“1000000=ONE MILLION THOUSAND ONLY”
    If i <> 0 Then
    lm = w3(a(i)) + " " + dw(i) + " " + lm '用来加上“THOUSAND OR MILLION OR BILLION”
    Else
    lm = w3(a(i)) '防止i=0时“lm=w3(a(i))+" "+dw(i)+" "+lm”多加两个尾空格
    End If
    Else
    lm = w3(a(i)) + lm
    End If
Next
xs = "" '用来存放转换后的小数部分
If z <> 0 Then
 If Trim(lstr) = "" Then
 xs = "CENTS" + " " + w2("$" + rstr + "0") + " "
 Else
 xs = "AND CENTS" + " " + w2("$" + rstr + "0") + " " '小数部分存在时转换小数部分
 End If
End If
Ywje = lm + " " + xs + "ONLY" '最后结果，加上ONLY
End Function
Public Function HZJe(Num As Double) '曹汉华 汉字金额转换函数 2003年10月9日（16位）
Num = Round(Num, 2)
Dim numb As String
Dim Ywje As String
Dim N As Integer
Dim numbe As Double
Dim mon, gwei, bwei, qwei, wwei, swei, swwei As String
Dim non As String
Dim i, lon As Integer
Dim L As Integer
numbe = Num * 100
numb = Trim(Str(numbe))
L = Len(numb)
b = L / 2
N = L
ReDim a(N) As String
For i = 1 To N
     non = Mid(numb, L, 1)
     If non = "1" Then
      mon = "壹"
     End If
     If non = "2" Then
     mon = "贰"
     End If
     If non = "3" Then
     mon = "叁"
     End If
     If non = "4" Then
      mon = "肆"
     End If
     If non = "5" Then
      mon = "伍"
     End If
     If non = "6" Then
     mon = "陆"
     End If
     If non = "7" Then
      mon = "柒"
     End If
     If non = "8" Then
      mon = "捌"
     End If
     If non = "9" Then
      mon = "玖"
     End If
     If non = "0" Then
      mon = "零"
     End If
     a(L) = mon
     L = L - 1
 Next i
   N = 1
   L = Len(numb)
   For i = 1 To L - 1
   a(N) = a(N) + a(N + i)
   Next i
   s1 = Trim(a(N))
   lon = Len(s1)
 If Mid(s1, lon, 1) <> "零" And (Mid(s1, lon, 1)) <> "" Then
    gwei = Mid(s1, lon, 1) + "分"
    Else
    gwei = ""
 End If
 
 If lon - 1 > 0 Then
  If Mid(s1, lon - 1, 1) <> "零" And Not IsNull(Mid(s1, lon - 1, 1)) Then
   swei = Mid(s1, lon - 1, 1) + "角"
   Else
   If Mid(s1, lon, 1) = "零" And Mid(s1, lon - 1, 1) = "零" Then
   swei = "整"
   Else
   swei = Mid(s1, lon - 1, 1)
  End If
  End If
 Else
 swei = ""
 End If
 If lon - 2 > 0 Then
 If Mid(s1, lon - 2, 1) <> "零" And Not IsNull(Mid(s1, lon - 2, 1)) Then
     bwei = Mid(s1, lon - 2, 1) + "圆"
     If Mid(s1, lon - 2, 1) = "" Then
      bwei = ""
     End If
   End If
 If Mid(s1, lon - 2, 1) = "零" Then
      bwei = "圆"
 End If
   Else
     bwei = ""
     End If
 If lon - 3 > 0 Then
  If Mid(s1, lon - 3, 1) <> "零" And Not IsNull(Mid(s1, lon - 3, 1)) Then
      qwei = Mid(s1, lon - 3, 1) + "拾"
      Else
      If bwei = "圆" And Mid(s1, lon - 3, 1) = "零" Then
       qwei = ""
       Else
      qwei = Mid(s1, lon - 3, 1)
       End If
     End If
    Else
   qwei = ""
  End If
 If lon - 4 > 0 Then
   If Mid(s1, lon - 4, 1) <> "零" And Not IsNull(Mid(s1, lon - 4, 1)) Then
      wwei = Mid(s1, lon - 4, 1) + "佰"
      Else
      If Mid(s1, lon - 3, 1) = "零" And Mid(s1, lon - 4, 1) = "零" Then
      wwei = ""
      Else
      wwei = Mid(s1, lon - 4, 1)
      End If
   End If
   Else
   wwei = ""
 End If
 
  If lon - 5 > 0 Then
   If Mid(s1, lon - 5, 1) <> "零" And Not IsNull(Mid(s1, lon - 5, 1)) Then
      swwei = Mid(s1, lon - 5, 1) + "仟"
   End If
   If Mid(s1, lon - 5, 1) = "零" And (Mid(s1, lon - 4, 1) = "零" Or IsNull(Mid(s1, lon - 4, 1))) Then
     swwei = ""
   End If
   If Mid(s1, lon - 5, 1) = "零" And Mid(s1, lon - 4, 1) <> "零" Then
    swwei = Mid(s1, lon - 5, 1)
   End If
End If
 
 If lon - 6 > 0 Then
   If Mid(s1, lon - 6, 1) <> "零" And Not IsNull(Mid(s1, lon - 6, 1)) Then
      bwwei = Mid(s1, lon - 6, 1) + "万"
      Else
      If IsNull(Mid(s1, lon - 6, 1)) Then
      bwwei = ""
      Else
      bwwei = "万"
      End If
   End If
   Else
   bwwei = ""
 End If
 
 If lon - 7 > 0 Then
   If Mid(s1, lon - 7, 1) <> "零" And Not IsNull(Mid(s1, lon - 7, 1)) Then
      gwwei = Mid(s1, lon - 7, 1) + "拾"
   End If
   If Mid(s1, lon - 7, 1) = "零" And ((Mid(s1, lon - 6, 1) = "零" Or IsNull(Mid(s1, lon - 6, 1)))) Then
      gwwei = ""
   End If
   If Mid(s1, lon - 7, 1) = "零" And Mid(s1, lon - 6, 1) <> "零" Then
    gwwei = Mid(s1, lon - 7, 1)
   End If
   Else
   gwwei = ""
 End If
 
 
 If lon - 8 > 0 Then
   If Mid(s1, lon - 8, 1) <> "零" And Not IsNull(Mid(s1, lon - 8, 1)) Then
      wwwei = Mid(s1, lon - 8, 1) + "佰"
   End If
   If Mid(s1, lon - 8, 1) = "零" And (Mid(s1, lon - 7, 1) = "零" Or IsNull(Mid(s1, lon - 7, 1))) Then
      wwwei = ""
   End If
   If Mid(s1, lon - 8, 1) = "零" And Mid(s1, lon - 7, 1) <> "零" Then
    wwwei = Mid(s1, lon - 8, 1)
   End If
   Else
   wwwei = ""
 End If
 If lon - 9 > 0 Then
   If Mid(s1, lon - 9, 1) <> "零" And Not IsNull(Mid(s1, lon - 9, 1)) Then
      longdx = Mid(s1, lon - 9, 1) + "仟"
   End If
   If Mid(s1, lon - 9, 1) = "零" And (Mid(s1, lon - 8, 1) = "零" Or IsNull(Mid(s1, lon - 8, 1))) Then
     longdx = ""
   End If
   If Mid(s1, lon - 9, 1) = "零" And Mid(s1, lon - 8, 1) <> "零" Then
    longdx = Mid(s1, lon - 9, 1)
   End If
   Else
End If
  
  If lon - 10 > 0 Then
    If Mid(s1, lon - 9, 1) = "零" And Mid(s1, lon - 8, 1) = "零" And Mid(s1, lon - 7, 1) = "零" And Mid(s1, lon - 6, 1) = "零" Then
    bwwei = ""
    End If
    If Mid(s1, lon - 9, 1) = "零" And Mid(s1, lon - 8, 1) = "零" And Mid(s1, lon - 7, 1) = "零" And Mid(s1, lon - 6, 1) = "零" And Mid(s1, lon - 5, 1) <> "零" Then
    bwwei = "零"
    End If
   If Mid(s1, lon - 10, 1) <> "零" And Not IsNull(Mid(s1, lon - 10, 1)) Then
      lonx = Mid(s1, lon - 10, 1) + "亿"
      Else
      If IsNull(Mid(s1, lon - 10, 1)) Then
      lonx = ""
      Else
      lonx = "亿"
      End If
     End If
   Else
   lonx = ""
  End If
  
  If lon - 11 > 0 Then
   If Mid(s1, lon - 11, 1) <> "零" And Not IsNull(Mid(s1, lon - 11, 1)) Then
      lgwwei = Mid(s1, lon - 11, 1) + "拾"
   End If
   If Mid(s1, lon - 11, 1) = "零" And ((Mid(s1, lon - 10, 1) = "零" Or IsNull(Mid(s1, lon - 10, 1)))) Then
      lgwwei = ""
   End If
   If Mid(s1, lon - 11, 1) = "零" And Mid(s1, lon - 10, 1) <> "零" Then
    lgwwei = Mid(s1, lon - 11, 1)
   End If
   Else
   lgwwei = ""
 End If
 If lon - 12 > 0 Then
   If Mid(s1, lon - 12, 1) <> "零" And Not IsNull(Mid(s1, lon - 12, 1)) Then
      logwwei = Mid(s1, lon - 12, 1) + "佰"
   End If
   If Mid(s1, lon - 12, 1) = "零" And ((Mid(s1, lon - 11, 1) = "零" Or IsNull(Mid(s1, lon - 11, 1)))) Then
      logwwei = ""
   End If
   If Mid(s1, lon - 12, 1) = "零" And Mid(s1, lon - 11, 1) <> "零" Then
    logwwei = Mid(s1, lon - 12, 1)
   End If
   Else
   logwwei = ""
 End If
 If lon - 13 > 0 Then
   If Mid(s1, lon - 13, 1) <> "零" And Not IsNull(Mid(s1, lon - 13, 1)) Then
      longwwei = Mid(s1, lon - 13, 1) + "仟"
   End If
   If Mid(s1, lon - 13, 1) = "零" And ((Mid(s1, lon - 12, 1) = "零" Or IsNull(Mid(s1, lon - 12, 1)))) Then
      longwwei = ""
   End If
   If Mid(s1, lon - 13, 1) = "零" And Mid(s1, lon - 12, 1) <> "零" Then
    longwwei = Mid(s1, lon - 13, 1)
   End If
   Else
   longwwei = ""
 End If
 HZJe = longwwei + logwwei + lgwwei + lonx + longdx + wwwei + gwwei + bwwei + swwei + wwei + qwei + bwei + swei + gwei
End Function