Access技巧接龙

Trynew

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

自动编号。实现对字符型编号自动加1。

?auto_number('北京001‘)

显示为：北京002

?auto_number('001‘)

显示为：002

程序虽只有两行，但用到了好几个内置的字符串函数，还有前导0的处理：

StrReverse：字符串取反

Val：字符串转数值，取字符串左边数字，包括空格

Left：取字符串左边指定个数的子字符串，对应的还有Right,Mid

Len：返回字符串长度

Format：格式化字符串，这里是返回带前导0的数值

String：返回重复指定个数的字符的字符串，类似的有Space函数

Function AutoNum(strNum As String) As String

    If Right(strNum, 1) = "0" Then

        AutoNum = Left(strNum, Len(strNum) - 1) & "1"

    Else

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

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

    End If

End Function

[此贴子已经被作者于2005-1-20 11:46:51编辑过]

Trynew

将秒为单位的如98989.90秒，转化为：时：分：＊＊.＊＊的形式的函数，如果前面是0则不显示！！Function SecToTime(dblSecond As Double) As String

    SecToTime = Format((Int(dblSecond) / 60 / 60 / 24), "HH:MM:SS")

    If Int(dblSecond) <> dblSecond Then SecToTime = SecToTime & Round(dblSecond - Int(dblSecond), 2)

    SecToTime = IIf(Left(SecToTime, 6) = "00:00:", Mid(SecToTime, 7), IIf(Left(SecToTime, 3) = "00:", Mid(SecToTime, 4), SecToTime))

End Function

Trynew

读取英语单词首字母的函数:Function GetWordZM(strEng As String) As String

    Dim i As Integer, Var As Variant

    Var = Split(strEng, " ")

    For i = 0 To UBound(Var)

        GetWordZM = GetWordZM & UCase(Left(Var(i), 1))

    Next

End Function

Trynew

汉字转拼音函数:HZQP()expression必需的。包含要转换的字符串。delimiter可选的。用于标识分隔拼音的字符串字符。如果忽略，则使用空格字符(" ")作为分隔符。如果delimiter是一个长度为零的字符串，则返回仅包含一个元素，即完整的 expression字符串。limit可选的。要返回拼音字符数，–1表示返回所有的拼音字符数，1表示返回拼音首字母。Function HZQP(expression As String, Optional delimiter As String = " ", Optional limit As Integer = -1) As String

Dim STR As String, arrWord(400) As String

Dim i As Integer, j As Integer

arrWord(1) = "吖a"

arrWord(2) = "哎ai"

arrWord(3) = "腤an"

arrWord(4) = "肮ang"

arrWord(5) = "凹ao"

arrWord(6) = "八ba"

arrWord(7) = "挀bai"

arrWord(8) = "扳ban"

arrWord(9) = "邦bang"

arrWord(10) = "勹bao"

arrWord(11) = "陂bei"

arrWord(12) = "奔ben"

arrWord(13) = "崩beng"

arrWord(14) = "皀bi"

arrWord(15) = "边bian"

arrWord(16) = "杓biao"

arrWord(17) = "憋bie"

arrWord(18) = "邠bin"

arrWord(19) = "仌bing"

arrWord(20) = "拨bo"

arrWord(21) = "峬bu"

arrWord(22) = "嚓ca"

arrWord(23) = "猜cai"

arrWord(24) = "飡can"

arrWord(25) = "仓cang"

arrWord(26) = "撡cao"

arrWord(27) = "冊ce"

arrWord(28) = "嵾cen"

arrWord(29) = "噌ceng"

arrWord(30) = "叉cha"

arrWord(31) = "拆chai"

arrWord(32) = "辿chan"

arrWord(33) = "伥chang"

arrWord(34) = "抄chao"

arrWord(35) = "车che"

arrWord(36) = "抻chen"

arrWord(37) = "阷cheng"

arrWord(38) = "吃chi"

arrWord(39) = "充chong"

arrWord(40) = "抽chou"

arrWord(41) = "出chu"

arrWord(42) = "搋chuai"

arrWord(43) = "巛chuan"

arrWord(44) = "刅chuang"

arrWord(45) = "吹chui"

arrWord(46) = "旾chun"

arrWord(47) = "踔chuo"

arrWord(48) = "呲ci"

arrWord(49) = "从cong"

arrWord(50) = "凑cou"

arrWord(51) = "粗cu"

arrWord(52) = "汆cuan"

arrWord(53) = "崔cui"

arrWord(54) = "邨cun"

arrWord(55) = "搓cuo"

arrWord(56) = "咑da"

arrWord(57) = "呆dai"

arrWord(58) = "丹dan"

arrWord(59) = "当dang"

arrWord(60) = "刀dao"

arrWord(61) = "恴de"

arrWord(62) = "灯deng"

arrWord(63) = "仾di"

arrWord(64) = "敁dian"

arrWord(65) = "刁diao"

arrWord(66) = "爹die"

arrWord(67) = "丁ding"

arrWord(68) = "丟diu"

arrWord(69) = "东dong"

arrWord(70) = "剅dou"

arrWord(71) = "嘟du"

arrWord(72) = "耑duan"

arrWord(73) = "垖dui"

arrWord(74) = "吨dun"

arrWord(75) = "多duo"

arrWord(76) = "妸e"

arrWord(77) = "奀en"

arrWord(78) = "儿er"

arrWord(79) = "发fa"

arrWord(80) = "帆fan"

arrWord(81) = "方fang"

arrWord(82) = "飞fei"

arrWord(83) = "分fen"

arrWord(84) = "丰feng"

arrWord(85) = "仏fo"

arrWord(86) = "紑fou"

arrWord(87) = "夫fu"

arrWord(88) = "旮ga"

arrWord(89) = "该gai"

arrWord(90) = "干gan"

arrWord(91) = "冈gang"

arrWord(92) = "皋gao"

arrWord(93) = "戈ge"

arrWord(94) = "给gei"

arrWord(95) = "根gen"

arrWord(96) = "更geng"

arrWord(97) = "工gong"

arrWord(98) = "勾gou"

arrWord(99) = "估gu"

arrWord(100) = "瓜gua"

arrWord(101) = "乖guai"

arrWord(102) = "关guan"

arrWord(103) = "光guang"

arrWord(104) = "归gui"

arrWord(105) = "衮gun"

arrWord(106) = "呙guo"

arrWord(107) = "铪ha"

arrWord(108) = "嗨hai"

arrWord(109) = "佄han"

arrWord(110) = "夯hang"

arrWord(111) = "蒿hao"

arrWord(112) = "诃he"

arrWord(113) = "黒hei"

arrWord(114) = "拫hen"

arrWord(115) = "亨heng"

arrWord(116) = "叿hong"

arrWord(117) = "侯hou"

arrWord(118) = "乎hu"

arrWord(119) = "花hua"

arrWord(120) = "怀huai"

arrWord(121) = "欢huan"

arrWord(122) = "巟huang"

arrWord(123) = "灰hui"

arrWord(124) = "昏hun"

arrWord(125) = "吙huo"

arrWord(126) = "丌ji"

arrWord(127) = "加jia"

arrWord(128) = "戋jian"

arrWord(129) = "江jiang"

arrWord(130) = "艽jiao"

arrWord(131) = "阶jie"

arrWord(132) = "巾jin"

arrWord(133) = "坕jing"

arrWord(134) = "冂jiong"

arrWord(135) = "丩jiu"

arrWord(136) = "凥ju"

arrWord(1

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

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

Trynew

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

    Me.AllowEdits = Me.NewRecord

End Sub

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