★SQL挂接的例子

welcpa

http://club.excelhome.net/dispbbs.asp?BoardID=4&replyID=339946&id=158226&skin=0 9楼

以下是引用[I]hayxb[/I]在2006-4-1 12:50:36的发言：

谢谢，有和SQL挂接的例子吗。

主要技术： 制作本程序需要以下的知识：（再次强调，这里他只是个例子，虽然他在实际工作是开始服役了的！） Excel的简单操作 这个是当然的，也是最基本的！ 对工作薄的锁定，设定密码以防止用户随便修改，该密码可以放权给实际操作员。 对文件的密码，可以防止未授权的人随便打开使用，相当于用户登录界面了，当然这也可以在Excel的界面中制作登录界面，然后调用数据库中的用户名表进行验证！ Excel的高级应用 起码需要会用VBA呀，宏什么的！ 以及为了美化界面而隐藏不需要的工具条、菜单等。 至于用不用Office助手只是界面上的一种美化！ 工程文件的密码设定，相当于保护源代码！使不能让未授权的人随意修改代码！ ADO的应用 想做数据库就不能不会他了！ 在此需要通过ADO来连接SQL-Server数据库，并通过ADO的RecordSet来返回记录集！ 在VFP中不管SPT也好、远程视图也好用的再熟练都不能说明能将ADO用的如何！ SQL-Server 数据库的熟练应用 为什么说要熟练应用呢，我发现不少的人只是拿SQL的数据库中的表来用而已！ 最起码建几个视图，写上一些存储过程来提高效率嘛！ 代码分析： 开始查询按钮 Private Sub cmdSearch_Click() On Error GoTo ErrorHandler ShowBallon "正在查找，请稍侯…" If Assistant.Visible = False Then Assistant.Visible = True Assistant.Animation = msoAnimationSearching '清除数据 ClearData Dim strPerCode As String Dim intYear As Integer, intMonth As Integer Dim strSQL As String, strConnectString As String Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim n As Integer Dim strExp As String cmdSearch.Enabled = False strPerCode = Range("C" & StartRow + 1).Value '工号 intYear = Range("C" & StartRow + 2).Value '年 intMonth = Range("C" & StartRow + 3).Value '月 '查询命令 strSQL = "usp_GetPayroll '" & strPerCode & "'," & intYear & "," & intMonth '连接串 strConnectString = "Driver={SQL Server};Server=redtiger;UID=sa;PWD=;DataBase=hr2000" cn.Open strConnectString rs.Open strSQL, cn, 2, 3 n = 0 Do While Not rs.EOF Range("G" & StartRow + 1).Value = rs("nYear").Value Range("G" & StartRow + 2).Value = rs("nMonth").Value Range("G" & StartRow + 3).Value = rs("cDptCode").Value Range("G" & StartRow + 4).Value = rs("cDptName").Value Range("G" & StartRow + 5).Value = rs("per_code").Value Range("G" & StartRow + 6).Value = rs("per_name").Value '-- 以下需要循环 ' 从4行开始循环 30 下(考虑不会超过30个工资项目) n = n + 1 Range("I" & StartRow + n).Value = n Range("J" & StartRow + n).Value = rs("cItemName").Value Range("K" & StartRow + n).Value = rs("nAmount").Value rs.MoveNext Loop Assistant.Animation = msoAnimationCheckingSomething cmdSearch.Enabled = True If n = 0 Then MsgBox "对不起，根据你的条件找不到相关数据，请重新查询！", _ vbExclamation, "查询结果" Else With Range("J" & StartRow + n + 1) .Value = "合 计" End With With Range("K" & StartRow + n + 1) strExp = "K" & StartRow + 1 & ":K" & StartRow + n .Value = "=sum(" + strExp + ")" End With End If ShowBallon "查询完毕，请核对工资项目，如有问题请及时联系管理员！" Exit Sub ErrorHandler: '-- 错误处理 MsgBox "执行有错：(" & Err.Number & ") " & Err.Description, _ vbCritical, "执行错误" ShowBallon "查询错误！" End Sub 重新设置按钮 Public Sub cmdReset_Click() Dim n As Integer Range("C5").Select cmdSearch.Enabled = True ShowBallon "就绪" '清除数据 ClearData With Windows.Application .Caption = "工资查询子系统" .DisplayFormulaBar = False .DisplayNoteIndicator = False .DisplayCommentIndicator = xlNoIndicator .DisplayExcel4Menus = False .DisplayScrollBars = False .DisplayAlerts = False .DisplayFullScreen = False .EditDirectlyInCell = True End With With Windows.Item(1) .DisplayGridlines = False .DisplayFormulas = False .DisplayHeadings = False .DisplayHorizontalScrollBar = False .DisplayOutline = False .DisplayVerticalScrollBar = False .DisplayWorkbookTabs = False End With With Toolbars For n = 1 To .Count .Item(n).Visible = False Next End With With MenuBars On Error Resume Next .Item("工资工具条").Delete .Add "工资工具条" For n = 1 To .Count .Item(n).Activate Next On Error GoTo ErrorHandler With .Item("工资工具条") .Menus.Add "工资查询系统 Excel + SQL Server 前后台 版权所有? 红虎工作室(honghoo.NET) 1998-2003" .Menus(1).Enabled = False ' .Menus.Add "帮助(&H)" ' .Menus("我的菜单(&M)").MenuItems.Add "退出(&X)" ' .Menus("帮助(&H)").MenuItems.Add "关于(&A)…" .Activate End With End With Exit Sub ErrorHandler: End Sub 退出系统按钮 Private Sub cmdExit_Click() ShowBallon "退出工资查询系统…" If MsgBox("是否要退出工资查询系统？", _ vbQuestion + vbYesNo, _ Windows.Application.Caption) = vbYes Then '-- 退出 Excel Windows.Application.Quit Else ShowBallon "欢迎您又回来了…" End If End Sub 清除数据的自定义过程 '-- 清除数据 Private Sub ClearData() Dim n As Integer '清除员工信息数据 For n = 1 To 6 Range("G" & StartRow + n).Value = "" Next '清除工资项目数据 For n = 1 To 30 Range("I" & StartRow + n).Value = "" Range("J" & StartRow + n).Value = "" Range("K" & StartRow + n).Value = "" Next End Sub 显示泡泡的自定义过程： '-- 显示泡泡 Private Sub ShowBallon(strMessage As String) Range("A2").Value = strMessage Windows.Application.StatusBar = strMessage Dim objBal As Balloon Set objBal = Assistant.NewBalloon With objBal .Heading = "工资查询小助手: " & Now() & Chr(13) & Chr(10) .Text = strMessage .BalloonType = msoBalloonTypeBullets .Mode = msoModeModeless .Icon = msoIconAlertInfo .Button = msoButtonSetNone .Show End With End Sub 当打开该文件时，ThisWorkbook 自动执行的代码（即进行“重新刷新”按钮的执行！）： Private Sub Workbook_Open() Sheet1.cmdReset_Click End Sub 全局定义： Const StartRow = 4 存储过程的定义： usp_GetPayroll 这里简单说明一下，具体代码省略！ 工资表由 人事档案表、部门表、工资项目表、工资记录表四个表关联得到的一个视图。 工资项目表中明确了每种工资是属于应扣还是应发，因而又通过自定义函数返回正负号，这些又由存储过程usp_GetPayroll完成，并接受3个参数：工号、年、月，返回一个记录集。 比如图上所示个人所得税在数据库中是正数的，但工资项目中的设定决定了他是需要被减的，因此他的数要乘以-1得到一个负数。 总结： 以上便是该程序制作的总体思想，基本上已经说的很明朗了，当然也不太可能说的面面俱到，篇幅、时间、精力都是有限的。只是希望能通过此文给大家一点启发，从而使以后的工作中找到更好的解决方案！ 总算也完成了此文的编排工作，不知道这种东西对大家的感觉如何，我也希望能收到一些反馈意见，使下次的工作中做的更好!

[此贴子已经被作者于2006-6-3 20:19:02编辑过]

liweibird

好贴！楼主还有什么好东东，继续哦