请选择 进入手机版 | 继续访问电脑版

Excel完美论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

快捷登录

 
版块
版块
班级
班级
班级
班级
其它
其它
查看: 11913|回复: 50

[分享] VBA分享工资管理系统

  [复制链接]

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
发表于 2015-6-8 22:15:48 | 显示全部楼层 |阅读模式
一键分享 一键分享
本帖最后由 远仑 于 2015-9-7 15:38 编辑

VBA开发工资管理系统
        本系列将经过一步一步的开发工资管理系统的过程与大家分享。感兴味的朋友可以一同来玩玩,促进VBA开发热情。

即然要开发,就开发我们工作中经常用到的(如:工资管理系统,进销存系统,通讯录系统等),心里面肯定要大约规划一下整个工程构造与设计思绪。
为以后更好,更便利的适用于工作、提升VBA综合学问。还在等什么一同动手吧!
大致分析一下要处理的难题:
      1.友好的交互界面,相对专业的登录窗口,是必不可少的。
      2.工资表的格式不能固定,不同企业工资表的格式都不相同,需求做到相对动态的格式。
      3.人员信息档案,工资表历史记载,存储方式。(大量运用SQL、ACC、VBA 学问的综合应用)。
      4.快速友好的查询页面。(跨表查询、跨工作簿查询、数据库查询与写入)。
      5.快速生成工资条、批量发送工资条
      6.跨年度快速生成工资表模版、援用上期工资表数据。
      7.打印设置  。(公司LOG,签字处设置-经过页眉页脚完成,不影响数据本身。)
      8.如何在用户未启用宏的情况下自动启用宏
      9.养成设置良好的工作表格式习气,对以后的加工处置非常重要。(别本人给本人挖坑^_^)
      

 

                                                  

VBA开发工资系统系列一.gif

工资管理系统.rar

423.79 KB, 下载次数: 186

售价: 10 财富币  [记录]

用户名:系统管理员;密码:00000

工资管理系统V20150419发布.rar

417.08 KB, 下载次数: 1236

评分

参与人数 13财富币 +250 鲜花 +24 技术分 +2 收起 理由
与心飞扬 + 1 支持原创
Deryl + 1
Bernhard + 1 支持分享
夏雨2005 + 1
Englebert + 1
建群不管事 + 150 + 2 支持原创
WangYing + 1
我心依然 + 1 支持原创
别安阳 + 1
阿斗 + 1 高手
swszlm + 2 支持原创
李丽霞 + 1 这个必须要支持的,辛苦
佛山小老鼠 + 100 + 10 + 2 支持原创,支持分享

查看全部评分


手机扫码浏览
回复

使用道具 举报

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
 楼主| 发表于 2015-6-9 08:14:52 | 显示全部楼层
条目
  1. Private Sub 修正_Click()
  2.     Dim MyStr As String
  3.     On Error Resume Next
  4.     If Me.ListBox1.ListCount Then
  5. 100:
  6.         MyStr = Application.InputBox("请重命名", "提示:条目称号不能相同", Type:=2)
  7.         If Len(MyStr) <= 1 Or MyStr = "False" Then MsgBox "至少输入两个字符做为条目称号": GoTo 100
  8.         Me.ListBox1.List(Me.ListBox1.ListIndex, 0) = MyStr
  9.     End If
  10. End Sub

  11. Private Sub 公式_Click()
  12.     Me.Hide
  13.     公式设置.Show
  14. End Sub

  15. Private Sub 上移_Click()
  16.     Dim i As Byte
  17.     If Me.ListBox1.ListCount Then
  18.         i = Me.ListBox1.ListIndex
  19.         If i = 0 Then Exit Sub
  20.         temp1 = Me.ListBox1.List(i, 0)
  21.         temp2 = Me.ListBox1.List(i - 1, 0)
  22.         Me.ListBox1.List(i - 1, 0) = temp1
  23.         Me.ListBox1.List(i, 0) = temp2
  24.         Me.ListBox1.ListIndex = i - 1
  25.     End If
  26. End Sub

  27. Private Sub 下移_Click()
  28.     Dim i As Byte
  29.     If Me.ListBox1.ListCount Then
  30.         i = Me.ListBox1.ListIndex
  31.         If i = Me.ListBox1.ListCount - 1 Then Exit Sub
  32.         temp1 = Me.ListBox1.List(i, 0)
  33.         temp2 = Me.ListBox1.List(i + 1, 0)
  34.         Me.ListBox1.List(i + 1, 0) = temp1
  35.         Me.ListBox1.List(i, 0) = temp2
  36.         Me.ListBox1.ListIndex = i + 1
  37.     End If
  38. End Sub

  39. Private Sub 删除_Click()
  40.     If Me.ListBox1.ListCount Then
  41.         Me.ListBox1.RemoveItem (Me.ListBox1.ListIndex)
  42.     End If
  43. End Sub

  44. Private Sub 添加_Click()
  45.     Me.ListBox1.AddItem ""
  46.     Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
  47.     修正_Click
  48. End Sub

  49. Private Sub 保管_Click()
  50.     Dim brr
  51.     If Me.ListBox1.ListCount <= 1 Then MsgBox "当前条目数小于两个不能保管": Exit Sub
  52.     brr = Application.Transpose(Me.ListBox1.List)
  53.     Sheets("根底信息表").Range("G1").CurrentRegion.ClearContents
  54.     Sheets("根底信息表").Range("G1").Resize(UBound(brr), 1) = Application.Transpose(brr)
  55.     Worksheets(3).Rows(2).ClearContents
  56.     Worksheets(3).Range("A2").Resize(1, UBound(brr)) = brr
  57. End Sub

  58. Private Sub 退出_Click()
  59. Unload Me
  60. End Sub

  61. Private Sub UserForm_Initialize()
  62.     刷新
  63. End Sub
  64. Sub 刷新()
  65.     Dim arr, brr
  66.     On Error Resume Next
  67.     arr = Application.Transpose(Sheets("根底信息表").Range("G1").CurrentRegion)
  68.     Me.ListBox1.Clear
  69.     If IsArray(arr) Then
  70.         Me.ListBox1.List = arr
  71.     Else
  72.         Me.ListBox1.AddItem arr
  73.     End If
  74.     Me.ListBox1.ListIndex = 0
  75. End Sub
复制代码

评分

参与人数 1鲜花 +1 收起 理由
闫小楠 + 1 支持分享

查看全部评分

回复 支持 反对

使用道具 举报

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
 楼主| 发表于 2015-6-9 08:18:54 | 显示全部楼层
公式设置
  1. Private Sub ComboBox1_Change()
  2. Me.TextBox1.Text = Me.TextBox1.Text & Me.ComboBox1.Text
  3. End Sub

  4. Private Sub CommandButton1_Click()
  5. Me.list1.AddItem Me.TextBox1.Text
  6. End Sub

  7. Private Sub CommandButton2_Click()
  8. Sheets("参数设置").Range("A2").Resize(Me.list1.ListCount, 1) = Me.list1.List
  9. End Sub

  10. Private Sub CommandButton3_Click()
  11. VBA.Unload Me
  12. End Sub

  13. Private Sub CommandButton4_Click()
  14. Me.list1.RemoveItem (Me.list1.ListIndex)
  15. End Sub

  16. Private Sub UserForm_Initialize()
  17. Dim arr
  18. arr = Application.Transpose(Sheets("根底信息表").Range("G1").CurrentRegion)
  19. Me.ComboBox1.List = arr
  20. End Sub
复制代码
回复 支持 反对

使用道具 举报

284

积分

2

技术分

65

鲜花

副班长

财富币
4665
学费币
26
推广币
175
学员红花
51
注册时间
2014-12-18

正式学员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
发表于 2015-6-9 08:42:51 | 显示全部楼层
回复 支持 反对

使用道具 举报

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
 楼主| 发表于 2015-6-9 09:16:20 | 显示全部楼层
本帖最后由 远仑 于 2015-6-9 09:24 编辑

二、
   制造登录窗口首先应该想到的是,假设用户的EXCEL未有启用宏,怎样办呢?
处理思绪:应用VB的别一分支 VBS跳过EXCEL的宏平安考证,下面请看演示。
解决启用宏的问题.gif

解决启用宏的问题.rar

18.9 KB, 下载次数: 524

回复 支持 反对

使用道具 举报

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
 楼主| 发表于 2015-6-9 09:21:23 | 显示全部楼层
工作簿的代码
  1. Private Sub Workbook_Open()
  2.     Application.Visible = False
  3.     UserForm1.Show
  4. End Sub
  5. Private Sub CommandButton1_Click()
  6.     If Len(Me.TextBox1.Text) = 0 Then MsgBox "请输入用户名": Exit Sub
  7.     If Len(Me.TextBox2.Text) = 0 Then MsgBox "请输入密码": Exit Sub
  8.     If Me.TextBox1.Text = "admin" And Me.TextBox2.Text = "123" Then
  9.         Application.Visible = True: VBA.Unload Me
  10.     Else
  11.         MsgBox "用户名或密码错误"
  12.     End If
  13. End Sub
复制代码
回复 支持 反对

使用道具 举报

1739

积分

16

技术分

336

鲜花

版主

Rank: 7Rank: 7Rank: 7

财富币
64729
学费币
161
推广币
18793
学员红花
2
注册时间
2014-12-17

管理员

    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
 楼主| 发表于 2015-6-9 09:22:28 | 显示全部楼层
VBS中的代码
  1. Set objXL = WScript.CreateObject("Excel.Application")
  2. a=runfile
  3. function RUNFILE()
  4. if filepath=vbNullString then
  5. msgbox "找不到相应的文件",16,"远伦提示:"
  6. else
  7. objXL.Workbooks.Open filepath
  8. objXL.Visible=true
  9. Set objXL = Nothing
  10. end if
  11. end function
  12. Function FilePath()
  13. Set objShell = CreateObject("Wscript.Shell")
  14. FilePath = Wscript.ScriptFullName
  15. Set objFSO = CreateObject("Scripting.FileSystemObject")
  16. Set objFile = objFSO.GetFile(FilePath)
  17. Set odjFiles = objFile.ParentFolder.Files
  18. FilePath = vbNullString
  19. For Each objFile In odjFiles
  20. 'msgbox rightb(objfile.name,10)
  21.     If StrComp(RightB(objFile.Name, 22), "BOOK1.xls", 1) = 0 Then
  22.         FilePath = objFile.Path
  23.         Exit For
  24.     End If
  25. Next
  26. Set objFSO = Nothing
  27. Set objFile = Nothing
  28. Set odjFiles = Nothing
  29. End Function
复制代码
回复 支持 反对

使用道具 举报

42

积分

0

技术分

2

鲜花

初级会员

Rank: 2

财富币
82
学费币
0
推广币
0
学员红花
0
注册时间
2015-1-21
    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
发表于 2015-6-9 09:28:00 | 显示全部楼层
回复 支持 反对

使用道具 举报

63

积分

0

技术分

0

鲜花

初级会员

Rank: 2

财富币
98
学费币
0
推广币
0
学员红花
0
注册时间
2015-6-5
    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
发表于 2015-6-9 10:23:49 | 显示全部楼层
高手,长见识了,真是山外有山
回复 支持 反对

使用道具 举报

356

积分

1

技术分

1

鲜花

初级会员

Rank: 2

财富币
498
学费币
2
推广币
10
学员红花
0
注册时间
2014-12-17
    购买在线课件和视频
    报班咨询联系电话
    Tel:186-6424-3619
    联系人:佛山小老鼠
    在线网络开设YY班级
    函数初级班
    函数中级班
    函数高级班
    VBA编程初级班
    VBA编程中级班
    VBA编程高级班
    透视表班
    290集视频
    525集excel视频大全
    189集免费excel视频
发表于 2015-6-9 10:28:01 | 显示全部楼层
高大上.................................................
If you want to  good at Excel, you need to repeat, repeat, and repeat.This is the only secret.
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则 快速回帖:

最近新开的班级:2018-7-28开vba初级班,周二、周四、周六晚上8点到10点上课      立即注册  登录 

手机微信——扫一扫 关注完美论坛公众号天天收到Excel分享

QQ|微信绑定|Archiver|手机版|Excel完美论坛 ( 粤ICP备14102225号  

GMT+8, 2018-9-24 15:39 , Processed in 0.244924 second(s), 54 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表