Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2758|回复: 12

[已解决]为什么复选框部分我用土办法提交时写不入数据库呢?但是可以清空。谢谢

[复制链接]
发表于 2013-6-5 19:22 | 显示全部楼层 |阅读模式
本帖最后由 qinhuan66 于 2013-6-5 19:24 编辑

老师您好为什么复选框部分我用土办法提交时写不入数据库呢?但是可以清空。谢谢
公开招聘报名系统.rar (277.96 KB, 下载次数: 20)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2013-6-5 19:53 | 显示全部楼层
复选框的结果不是写在单元格里的,要通过判断控件的值,来依次写入数据库中
回复

使用道具 举报

 楼主| 发表于 2013-6-5 19:57 | 显示全部楼层
那么的帅 发表于 2013-6-5 19:53
复选框的结果不是写在单元格里的,要通过判断控件的值,来依次写入数据库中

好的谢谢老师
回复

使用道具 举报

发表于 2013-6-5 20:18 | 显示全部楼层
你直接搬我的过程,不改下,
回复

使用道具 举报

 楼主| 发表于 2013-6-5 20:19 | 显示全部楼层
此问题还没解决,继续=
回复

使用道具 举报

 楼主| 发表于 2013-6-5 20:20 | 显示全部楼层
hwc2ycy 发表于 2013-6-5 20:18
你直接搬我的过程,不改下,

老师呀!我是刚上手的,难度高的一下子不懂如何下手呀
回复

使用道具 举报

发表于 2013-6-5 20:32 | 显示全部楼层
==给你改吧。
回复

使用道具 举报

发表于 2013-6-5 23:10 | 显示全部楼层
本帖最后由 hwc2ycy 于 2013-6-5 23:32 编辑

对于添加了大量数据的话,可以用这个先修改表结构。
  1. Sub 修改表结构()

  2.     Dim AccessFile As String, Database As String, sql As String
  3.     Dim StrConn$, strSql$
  4.     Dim AdoCmd As Object
  5.     Dim AdoConn As Object

  6.     On Error GoTo ErrorHandler


  7.     AccessFile = ThisWorkbook.Path & "\gkzp.mdb"
  8.     Database = "gkzp"

  9.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  10.               "Data Source='" & AccessFile & "';jet oledb:Database Password=695360052"

  11.     Set AdoConn = CreateObject("ADODB.Connection")
  12.     With AdoConn
  13.         .CursorLocation = 3
  14.         .Mode = 3
  15.         .CommandTimeout = 5
  16.         .connectionTimeout = 5
  17.         .Open StrConn
  18.     End With

  19.     Set AdoCmd = CreateObject("ADODB.Command")

  20.     With AdoCmd
  21.         .ActiveConnection = AdoConn
  22.         .CommandText = "alter TABLE " & Database & " ADD COLUMN 提供材料 text(120)"
  23.         .Execute
  24.         .CommandText = "alter TABLE " & Database & " ADD COLUMN 资格审查情况 text(10)"
  25.         .Execute
  26.     End With

  27.     MsgBox "数据库结构修改成功"
  28.     Exit Sub

  29. ErrorHandler:
  30.     MsgBox Err.Number & vbCrLf & _
  31.            Err.Description
  32.     Err.Clear
  33. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
qinhuan66 + 3 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2013-6-5 23:13 | 显示全部楼层
hwc2ycy 发表于 2013-6-5 23:10
对于添加了大量数据的话,可以用这个先修改表结构。

好的谢谢老师我先试一下
回复

使用道具 举报

发表于 2013-6-5 23:28 | 显示全部楼层
本帖最后由 hwc2ycy 于 2013-6-5 23:30 编辑
  1. Sub 提交到Access数据库()

  2.     Dim AccessFile As String, Database As String, sql As String
  3.     Dim StrConn$, strSql$
  4.     Dim lLastRow&
  5.     Dim arr, i&, j As Byte

  6.     Dim AdoxCat As Object
  7.     Dim AdoCmd As Object
  8.     Dim AdoConn As Object
  9.     Dim AdoRst As Object

  10.     On Error GoTo Errcheck
  11.     AccessFile = ThisWorkbook.Path & "\gkzp.mdb"
  12.     Database = "gkzp"
  13.     If Dir(AccessFile) = "" Then

  14.         '检测文件是否存在,不存在则创建数据库
  15.         Set AdoxCat = CreateObject("adox.catalog")
  16.         AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile & ";Jet OLEDB:Database Password=695360052;"
  17.         Set AdoConn = AdoxCat.ActiveConnection
  18.         Set AdoCmd = CreateObject("ADODB.Command")
  19.         Set AdoCmd.ActiveConnection = AdoConn
  20.         AdoCmd.CommandText = "CREATE TABLE " & Database & _
  21.                              " (报名序号 text(3),报名时间 datetime ,报考类型 text(30),操作员 text(6),姓名 text(8),性别 text(2),出生日期 datetime ,籍贯 text(30),民族 text(10)," & _
  22.                              "政治面貌 text(20),健康状况 text(20),参加工作时间 datetime ,最高学历毕业时间 datetime ,移动电话 text(12),固定电话 text(11),身份证号 text(18),电子邮箱 text(20)," & _
  23.                              "工作单位及职务(或家庭住址) text(50),报考职位 text(50),全日制教育 text(50),全日制教育毕业院校及专业 text(50),在职教育 text(50),在职教育毕业院校及专业 text(50),学习工作简历 text(50),提供材料 text(120),资格审查情况 text(10))"

  24.         AdoCmd.Execute
  25.         Set AdoCmd = Nothing
  26.         Set AdoxCat = Nothing
  27.         Set AdoConn = Nothing

  28.     End If
  29.     If Len([B3]) = 0 Or Len([F3]) = 0 Or Len([J3]) = 0 Or Len([B4]) = 0 Or Len([F4]) = 0 Or Len([J4]) = 0 Or Len([B5]) = 0 Or Len([F5]) = 0 Or Len([J5]) = 0 Or Len([C6]) = 0 Or Len([J6]) = 0 Or Len([C7]) = 0 Or Len([J7]) = 0 Or Len([E8]) = 0 Or Len([E9]) = 0 Or Len([D10]) = 0 Or Len([I10]) = 0 Or Len([D11]) = 0 Or Len([I11]) = 0 Or Len([B12]) = 0 Then
  30.         MsgBox "对不起!黄色区域数据输入不完整,请先填好数据再进行提交。"
  31.         Exit Sub
  32.     End If



  33.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  34.               "Data Source='" & AccessFile & "';jet oledb:Database Password=695360052"

  35.     Set AdoConn = CreateObject("ADODB.Connection")

  36.     AdoConn.CursorLocation = 3
  37.     AdoConn.Mode = 3
  38.     AdoConn.CommandTimeout = 5
  39.     AdoConn.connectionTimeout = 5
  40.     AdoConn.Open StrConn

  41.     If AdoConn.State <> 1 Then MsgBox "数据库连接失败", vbCritical + vbOKOnly: Exit Sub

  42.     strSql = "select * from " & Database & " where 报名时间=#" & [L4] & "# " & " and 姓名 like '" & [B3] & "' and 身份证号='" & [C7] & "'"



  43.     Dim strTGCL[        DISCUZ_CODE_1        ]nbsp;   '提供材料
  44.     Dim strZGSCQK[        DISCUZ_CODE_1        ]nbsp; '资格审查情况
  45.     Dim item1

  46.     With Sheet1
  47.         For Each item1 In .OLEObjects   '控件遍历
  48.             With item1
  49.                 If .Name Like "CheckBox*" Then  '过滤非CHECKBOX
  50.                     Select Case True
  51.                         Case .Object.Value And .TopLeftCell.Row = 17    '17行的数据
  52.                             strTGCL = strTGCL & .Object.Caption & ","
  53.                         Case .Object.Value And .TopLeftCell.Row = 22    '22行的数据
  54.                             strZGSCQK = strZGSCQK & item1.Object.Caption & ","
  55.                     End Select

  56.                 End If
  57.             End With
  58.         Next
  59.     End With

  60.     If Len(strTGCL) Then
  61.         strTGCL = Left(strTGCL, Len(strTGCL) - 1)  '过滤最后的","
  62.     Else
  63.         strTGCL = "无"
  64.     End If

  65.     If Len(strZGSCQK) Then
  66.         strZGSCQK = Left(strZGSCQK, Len(strZGSCQK) - 1)  '过滤最后的","
  67.     Else
  68.         strZGSCQK = "无"
  69.     End If



  70.     Set AdoRst = AdoConn.Execute(strSql)
  71.     If AdoRst.RecordCount = 0 Then        '
  72.         strSql = " insert into " & Database & " values('" & [L3] & "',#" & [L4] & "#,'" & [L5] & "','" & [L6] & "','" & [B3] & "','" & [F3] & "',#" & [J3] & "#,'" & [B4] & "','" & [F4] & "','" & _
  73.                  [J4] & "','" & [B5] & "',#" & [F5] & "#,'" & [J5] & "','" & [C6] & "','" & [J6] & "','" & [C7] & "','" & [J7] & "','" & _
  74.                  [E8] & "','" & [E9] & "','" & [D10] & "','" & [I10] & "','" & [D11] & "','" & [I11] & "','" & [B12] & "','" & strTGCL & "','" & strZGSCQK & "')"
  75.         AdoConn.Execute strSql
  76.         MsgBox "呵呵!本次数据已成功添加的数据库"
  77.         [B3:C3,F3:G3,J3,L3,B4:C4,F4:G4,J4,L4,B5:C5,F5:G5,J5,L5,C6:G6,J6,L6,C7:G7,J7:L7,E8:L8,E9:L9,D10:F10,I10:L10,D11:F11,I11:L11,B12:L16] = ""
  78.         [f2] = [f2] + 1

  79.         '清除单选框
  80.         With Sheet1
  81.             For Each item1 In .OLEObjects   '控件遍历
  82.                 With item1
  83.                     Select Case TypeName(.Object)
  84.                         Case "CheckBox"
  85.                             .Object.Value = False
  86.                     End Select
  87.                 End With
  88.             Next
  89.         End With

  90.     Else
  91.         MsgBox "呵呵!请注意:记录已经存在,不能重复添加!"
  92.     End If

  93.     AdoConn.Close
  94.     Set AdoConn = Nothing
  95.     Exit Sub

  96. Errcheck:

  97.     MsgBox Err.Number & vbNewLine & _
  98.            Err.Description
  99. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
qinhuan66 + 3 神马都是浮云

查看全部评分

回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 05:55 , Processed in 0.946346 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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