Outlook) (CalendarModule.Position 属性

返回或设置一个 Long 值,该值代表 CalendarModule 对象在导航窗格中显示时的序号位置。 读/写。

语法

表达式位置

表达 一个代表 CalendarModule 对象的变量。

备注

此属性只能设置为 1 和 9 之间的值。 如果您尝试将其设置为该范围以外的值,则会出现错误。

更改给定的 CalendarModule 对象的该属性的值更改其他导航模块 NavigationModules 集合,具体取决于新值和原始值之间相对变化中的 位置 的值。

  • 如果新值小于原始值,则指定的 CalendarModule 对象将上移到新位置和的其他导航模块中已经等于或低于该新位置向下移动。

  • 如果新值大于原始值,则指定的 CalendarModule 对象将下移到新位置并将介于旧位置与新位置之间的其他导航模块上移,填充旧位置。

示例

以下Visual Basic for Applications (VBA) 示例代码尝试从导航窗格中检索日历导航模块。 如果成功检索模块,则代码会将 CalendarModule 对象的 Position 属性设置为“1”,这会将其移动到导航窗格的顶部。 最后,代码将 NavigationPane 对象的 CurrentModule 属性设置为检索到的日历模块,该模块在导航窗格中选择该模块。

Sub MoveCalendarModuleFirst() 
 
 Dim objPane As NavigationPane 
 
 Dim objModule As CalendarModule 
 
 
 
 On Error GoTo ErrRoutine 
 
 
 
 ' Get the current NavigationPane object. 
 
 Set objPane = Application.ActiveExplorer.NavigationPane 
 
 
 
 ' Get the Calendar navigation module 
 
 ' from the navigation pane. 
 
 Set objModule = objPane.Modules.GetNavigationModule( _ 
 
 olModuleCalendar) 
 
 
 
 ' If a CalendarModule object is present, 
 
 ' make it the first navigation module displayed in the 
 
 ' Navigation Pane. 
 
 If Not (objModule Is Nothing) Then 
 
 objModule.Position = 1 
 
 End If 
 
 
 
 ' Select the Calendar navigation module in the 
 
 ' Navigation Pane. 
 
 Set objPane.CurrentModule = objModule 
 
 
 
EndRoutine: 
 
 On Error GoTo 0 
 
 Set objModule = Nothing 
 
 Set objPane = Nothing 
 
 Exit Sub 
 
 
 
ErrRoutine: 
 
 Debug.Print Err.Number & " (&H" & Hex(Err.Number) & ")" 
 
 Select Case Err.Number 
 
 Case -2147024809 '&H80070057 
 
 ' Typically occurs if you set the Position 
 
 ' property less than 1 or greater than 9. 
 
 MsgBox Err.Number & " - " & Err.Description, _ 
 
 vbOKOnly Or vbCritical, _ 
 
 "MoveCalendarModuleFirst" 
 
 End Select 
 
 GoTo EndRoutine 
 
End Sub

另请参阅

CalendarModule 对象

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈? 请参阅 Office VBA 支持和反馈,获取有关如何接收支持和提供反馈的指南。