Access技巧接龙

Trynew

让表中的所有空值等于其对应字段的上一条记录值的函数，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

hgt

如果一对多关系的表，用了“自动编号”连接，就会备份后不能还原，因为“自动编号”不能写入。

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

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

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

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

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



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

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

hgt

可是很不幸，上面那种方法不能在 ODBC 中的 数据表 粘贴多行。

Trynew

由字段名称求字段标题函数及由字段标题求字段名称函数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

ntcat

关于取得汉字的第一个拼音字母的函数,推荐使用我的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

方漠

汉字拼音首字母，我也贴一个，不过不是我写的。呵呵！'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

Trynew

如何使窗体只能新增记录，不能修改旧记录在窗体的成为当前记录时间增加如下语句Private Sub Form_Current()

    Me.AllowEdits = Me.NewRecord

End Sub

灵芝

回楼上,试过好用

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

Trynew

以下是引用灵芝在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

Trynew

支持拼音首字母的组合框函数及实例(非常实用，能大大提高选择和录入速度)

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