我在哪里放VBA代码?

时间:2017-06-06 17:43:07

标签: database vba function ms-access

古斯塔夫非常向我提供了代码,但我不知道该把它放在哪里。

将函数放入模块是否正确?其他两行代码怎么样?

我习惯查询表达式,但是afaik我不能把VBA代码放在那里。

我尝试了各种各样的东西,但我一直在“#Name?”在我的表格上。

古斯塔夫的帖子:

  

我想你可以像这样计算:

RetentionStartdate = DateAdd("ww", 14, DateAdd("d", vbSaturday - Weekday    (HireDate), HireDate))
     

从那时起,您可以算上整整几个月:

RetentionMonths = Months(RetentionStartDate, Date)
     

使用这样的函数:

Public Function Months( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  Optional ByVal booLinear As Boolean) _
  As Integer

' Returns the difference in full months between datDate1 and datDate2.
'
' Calculates correctly for:
'   negative differences
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'   negative date/time values (prior to 1899-12-29)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of month counts.
' For a given datDate1, if datDate2 is decreased stepwise one month from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
'   3, 2, 1, 0,  0, -1, -2
' If booLinear is True, the sequence will be:
'   3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDate1 and datDate2 will return
' results of same absolute Value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDate1 and datDate2 will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().

' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of months to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2010-03-30. Cactus Data ApS, CPH.

  Dim intDiff   As Integer
  Dim intSign   As Integer
  Dim intMonths As Integer

  ' Find difference in calendar months.
  intMonths = DateDiff("m", datDate1, datDate2)
  ' For positive resp. negative intervals, check if the second date
  ' falls before, on, or after the crossing date for a 1 month period
  ' while at the same time correcting for February 29. of leap years.
  If DateDiff("d", datDate1, datDate2) > 0 Then
    intSign = Sgn(DateDiff("d", DateAdd("m", intMonths, datDate1), datDate2))
    intDiff = Abs(intSign < 0)
  Else
    intSign = Sgn(DateDiff("d", DateAdd("m", -intMonths, datDate2), datDate1))
    If intSign <> 0 Then
      ' Offset negative count of months to continuous sequence if requested.
      intDiff = Abs(booLinear)
    End If
    intDiff = intDiff - Abs(intSign < 0)
  End If

  ' Return count of months as count of full 1 month periods.
  Months = intMonths - intDiff

End Function

1 个答案:

答案 0 :(得分:0)

要在查询中使用,请创建辅助函数:

Public Function RetentionMonths(ByVal HireDate As Date) As Integer

    Dim RetentionStartdate As Date

    RetentionStartdate = DateAdd("ww", 14, DateAdd("d", vbSaturday - Weekday(HireDate), HireDate))

    RetentionMonths = Months(RetentionStartDate, Date)

End Function

Months函数一样,将此函数保存在代码模块中,您的查询可能如下所示:

Select *, RetentionMonths([HireDate]) As RetentionMonths
From YourTable