设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
楼主: tmtony
打印 上一主题 下一主题

[Access本身] Access技巧接龙

[复制链接]
21#
发表于 2004-12-17 20:07:00 | 只看该作者
让表中的所有空值等于其对应字段的上一条记录值的函数,rstName是表名或查询的名称,要引用DAOPublic Function InsNullFld(rstName As String) As Boolean

    Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset

    Dim i As Integer, isChn As Boolean

    Set rst1 = CurrentDb().OpenRecordset(rstName)

    Set rst2 = CurrentDb().OpenRecordset(rstName)

    rst2.MoveNext

    Do While Not rst2.EOF

        rst2.Edit

        isChn = False

        For i = 0 To rst2.Fields.Count - 1

            If IsNull(rst2.Fields(i)) Then

                rst2.Fields(i) = rst1.Fields(i)

                isChn = True

                InsNullFld = True

            End If

        Next

        If isChn Then rst2.Update

        rst1.MoveNext

        rst2.MoveNext

    Loop

End Function

22#
发表于 2004-12-17 21:25:00 | 只看该作者
如果一对多关系的表,用了“自动编号”连接,就会备份后不能还原,因为“自动编号”不能写入。

可以用办法代替“自动编号”,也能实现“自动编号”的功能。下面办法是“Lwwvb”版主发明的,我把它改進了。

支持多用户同时使用,不会冲突,不会重复编号。可以完全代替“自动编号”

1;做一个表,只有一行,放个 Int 类型的字段“ID”,初值为“0”用来放参考编号,

2;做一个“更新查询”更新这个“ID”,使每次执行“[ID] + 1”作为“自动编号”用。

3;在窗体的“插入前”写事件,先执行“更新查询”,然后取得这个“ID”值放在窗体“ID”控件的“默认值”里面。再在“插入后”事件清除“默认值”。



注意:要有控件绑定“ID”,控件才有“默认值”,窗体的字段没有“默认值”,数据表可以使用隐藏列。

[此贴子已经被作者于2004-12-17 13:26:14编辑过]

23#
发表于 2004-12-19 01:01:00 | 只看该作者
可是很不幸,上面那种方法不能在 ODBC 中的 数据表 粘贴多行。
24#
发表于 2004-12-20 17:52:00 | 只看该作者
由字段名称求字段标题函数及由字段标题求字段名称函数ublic Function GetFldName(TblName As String, FldCaption As String) As String

On Error Resume Next

    Dim rst As DAO.Recordset, i As Integer

    Set rst = CurrentDb().OpenRecordset(TblName)

        For i = 0 To rst.Fields.Count - 1

            If rst.Fields(i).Properties("Caption") = FldCaption Then

                GetFldName = rst.Fields(i).Name

                Exit For

            End If

        Next

End FunctionPublic Function GetFldCaption(TblName As String, FldName As String) As String

On Error Resume Next

    Dim rst As DAO.Recordset

    Set rst = CurrentDb().OpenRecordset(TblName)

    GetFldCaption = rst.Fields(FldName).Properties("Caption")

End Function

如果在窗体内部应用,则不需要表名参数,用Me.Recordset来代替上面函数的Rst即可。Private Function GetFldName(FldCaption As String) As String

On Error Resume Next

       Dim i As Integer

       For i = 0 To Me.Recordset.Fields.Count - 1

            If Me.Recordset.Fields(i).Properties("Caption") = FldCaption Then

                GetFldName = Me.Recordset.Fields(i).Name

                Exit For

            End If

        Next

End FunctionPrivate Function GetFldCaption(FldName As String) As String

       GetFldCaption = Me.Recordset.Fields(FldName).Properties("Caption")

End Function

25#
发表于 2004-12-28 19:13:00 | 只看该作者
关于取得汉字的第一个拼音字母的函数,推荐使用我的GetPyAbOfHz函数.速度比上述HZPY快一倍. 不信? 测试代码附后Public Function GetFirstChr(ByVal sSrc As String)

    Dim sTemp As String

    sTemp = Left(sSrc, 1)

Select Case Asc(sTemp)

    Case 48 To 122

         GetFirstChr = sTemp

    Case Is >= Asc("匝")

         GetFirstChr = "Z"

    Case Is >= Asc("压")

         GetFirstChr = "Y"

    Case Is >= Asc("昔")

         GetFirstChr = "X"

    Case Is >= Asc("挖")

         GetFirstChr = "W"

    Case Is >= Asc("塌")

         GetFirstChr = "T"

    Case Is >= Asc("撒")

         GetFirstChr = "S"

    Case Is >= Asc("然")

         GetFirstChr = "R"

    Case Is >= Asc("期")

         GetFirstChr = "Q"

    Case Is >= Asc("啪")

         GetFirstChr = ""

    Case Is >= Asc("哦")

         GetFirstChr = "O"

    Case Is >= Asc("拿")

         GetFirstChr = "N"

    Case Is >= Asc("妈")

         GetFirstChr = "M"

    Case Is >= Asc("垃")

         GetFirstChr = "L"

    Case Is >= Asc("喀")

         GetFirstChr = "K"

    Case Is >= Asc("击")

         GetFirstChr = "J"

    Case Is >= Asc("哈")

         GetFirstChr = "H"

    Case Is >= Asc("噶")

         GetFirstChr = "G"

    Case Is >= Asc("发")

         GetFirstChr = "F"

    Case Is >= Asc("蛾")

         GetFirstChr = "E"

    Case Is >= Asc("搭")

         GetFirstChr = "D"

    Case Is >= Asc("擦")

         GetFirstChr = "C"

    Case Is >= Asc("芭")

         GetFirstChr = "B"

    Case Is >= Asc("啊")

         GetFirstChr = "A"

    Case Else

         GetFirstChr = "0"

End Select

End Function

'取得汉字的拼音缩写

Public Function GetPyAbOfHz(ByVal sHz As String) As String

    Dim sTmp, ch As String

    Dim i As Integer

    For i = 1 To Len(sHz)

        ch = Mid(sHz, i, 1)

        Select Case ch

            Case ".", "(", ")", "+", "-"

                sTmp = sTmp & ch

            Case " "

            Case Else

                sTmp = sTmp & GetFirstChr(ch)

        End Select

    Next

    GetPyAbOfHz = sTmp

End Function

'----------------------------------------速度测试代码:---------Public Sub speed_HZPY()

    Dim a1 As Single

        Dim i As Long    a1 = Timer

    For i = 1 To 66542

        HZPY ("地要不是在遥呐喊浊夺标炽烈二有遥感地于规划")

    Next

    Debug.Print Timer - a1

End Sub

Public Sub SPEED_GetPyAbOfHz()

    Dim a1 As Single

    Dim i As Long

    a1 = Timer

    For i = 1 To 66542

        GetPyAbOfHz ("地要不是在遥呐喊浊夺标炽烈二有遥感地于规划")

    Next

    Debug.Print Timer - a1

   

End Sub
26#
发表于 2004-12-30 01:20:00 | 只看该作者
汉字拼音首字母,我也贴一个,不过不是我写的。呵呵!'HZPY(String):返回汉字拼音首字母函数:Function HZPY(hzstr As String) As String

Dim p0 As String, C As String, STR As String

Dim i As Integer, j As Integer

p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"

For i = 1 To Len(hzstr)

    C = "z"

    STR = Mid(hzstr, i, 1)

    If Asc(STR) > 0 Then

        C = STR

    Else

        For j = 1 To 26

            If Mid(p0, j, 1) > STR Then

                C = Chr(95 + j)

                Exit For

            End If

        Next

    End If

    HZPY = HZPY + C

Next

End Function
27#
发表于 2004-12-30 21:56:00 | 只看该作者
如何使窗体只能新增记录,不能修改旧记录在窗体的成为当前记录时间增加如下语句Private Sub Form_Current()

    Me.AllowEdits = Me.NewRecord

End Sub

28#
发表于 2005-1-10 04:22:00 | 只看该作者

回楼上

回楼上,试过好用

但:如果strNum 尾数为0时会出错,如strNum =10,算法还得再加一句.
29#
发表于 2005-1-20 19:51:00 | 只看该作者
以下是引用灵芝在2005-1-9 20:22:29的发言:



回楼上,试过好用

但:如果strNum 尾数为0时会出错,如strNum =10,算法还得再加一句.

Function AutoNum(strNum As String) As String

    AutoNum = StrReverse(Val(StrReverse(strNum)))

    AutoNum = IIf(Right(strNum, 1) = "0", Left(strNum, Len(strNum) - 1) & "1", Left(strNum, Len(strNum) - Len(AutoNum)) & Format((AutoNum + 1), String(Len(AutoNum), "0")))

End Function

30#
发表于 2005-1-20 19:57:00 | 只看该作者
支持拼音首字母的组合框函数及实例(非常实用,能大大提高选择和录入速度)

Public Function ComboBoxKeyPress(KeyAscii As Integer) As String

'调用方法  在组合框的keypress方法中加入:

'--------------------------------------------

'    If ComboBoxKeyPress(KeyAscii) <> "" Then KeyAscii = 0

'--------------------------------------------

On Error GoTo Err

Dim i As Integer

With Screen.ActiveControl

    If .ControlType = acComboBox And (KeyAscii >= Asc("a") And KeyAscii <= Asc("z")) Then

    '只能由组合框输入小写字母时调用

        ComboBoxKeyPress = Nz(HZPY(Left(.Text, .SelStart))) & Chr(KeyAscii)

        While HZPY(Left(.ItemData(i), .SelStart + 1)) <> ComboBoxKeyPress And i < .ListCount - 1

            i = i + 1

        Wend

        If i <> .ListCount And Mid(.ItemData(i), .SelStart + 1, 1) <> Chr(KeyAscii) Then

            ComboBoxKeyPress = Left(.ItemData(i), .SelStart + 1)

            .Value = Null

            SendKeys ComboBoxKeyPress

        Else

            ComboBoxKeyPress = ""      '为英文时不代换,否则会进入死循环

        End If

    End If

End With

Exit Function

Err:

    ComboBoxKeyPress = ""

End FunctionFunction HZPY(hzstr As String) As String

Dim p0 As String, C As String, str As String

Dim i As Integer, j As Integer

p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"

For i = 1 To Len(hzstr)

    C = "z"

    str = Mid(hzstr, i, 1)

    If Asc(str) > 0 Then

        C = str

    Else

        For j = 1 To 26

            If Mid(p0, j, 1) > str Then

                C = Chr(95 + j)

                Exit For

            End If

        Next

    End If

    HZPY = HZPY + C

Next

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

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 06:56 , Processed in 0.100110 second(s), 33 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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