2017-04-01 290 views
1

我正在使用一個小的Excel-VBA GUI /窗體供用戶讀取/寫入.ini文件中的數據。 UserForm有一個MultiPage,用戶在運行時創建頁面,每個頁面將代表一個ini部分。此外,這些部分還在主節中編入索引以供進一步處理:此時,我循環瀏覽MultiPage頁面以創建此索引。問題是,用戶需要能夠改變這個索引的順序。現在,是否有可能在運行時移動多頁中的頁面?我在想什麼的效果Excel-VBA MultiPage:在運行時移動/重新排序/索引頁面?

Me.MultiPage1.Pages(i).Index = i + 1 

但顯然這是行不通的。或者,有沒有一種方法可以傳遞一個before:=或者類似於Multipage.Pages.Add的東西來解決它? 如果這些都不起作用,我想我會用MoveUp/Down按鈕創建一個單獨的ListBox控件。打開任何更好的解決方案。

回答

2

假設你有一個UserForm,看起來像這樣:

enter image description here

然後你可以包括下面的示例代碼移動Page項目MultiPage的順序:

Option Explicit 

'moves selected page to left 
Private Sub CommandButton1_Click() 

    Dim pag As MSForms.Page 
    Dim lngPageCount As Long 

    ' get reference to page 
    Set pag = Me.MultiPage1.SelectedItem 
    ' get number of pages in multipage 
    lngPageCount = Me.MultiPage1.Pages.Count 
    ' check if trying to go left beyond first page and put to end 
    ' otherwise decrement pages position in multipage 
    If pag.Index = 0 Then 
     pag.Index = lngPageCount - 1 
    Else 
     pag.Index = pag.Index - 1 
    End If 

    ' update caption 
    Me.Label1.Caption = pag.Name & " is at index " & pag.Index 

End Sub 

'moves selected page to right 
Private Sub CommandButton2_Click() 

    Dim pag As MSForms.Page 
    Dim lngPageCount As Long 

    ' get reference to page 
    Set pag = Me.MultiPage1.SelectedItem 
    ' get number of pages in multipage 
    lngPageCount = Me.MultiPage1.Pages.Count 
    ' check if trying to go right beyond number of pages and put to start 
    ' otherwise increment pages position in multipage 
    If pag.Index = lngPageCount - 1 Then 
     pag.Index = 0 
    Else 
     pag.Index = pag.Index + 1 
    End If 

    ' update caption 
    Me.Label1.Caption = pag.Name & " is at index " & pag.Index 

End Sub 
+0

非常感謝羅賓,完美。所以Page.Index確實存在,我只需要將頁面聲明爲一個單獨的對象,對嗎?由於我的頁面是在運行時創建的,所以我不得不修改代碼並放入一個類中。我將在解決問題的過程中發佈解決方案,希望這是適當的過程。謝謝。 –

+0

嗨,很高興它有幫助。如果您有解決問題的代碼更新,您可以發佈自己問題的答案。這可能是一個更好的選擇,而不是改變問題。 –

+0

@RobinMackenzie不錯:) –

1

對於任何人在未來尋找這個,這裏是使用Robin代碼的完整解決方案(謝謝!),但是在運行時創建的頁面放入一個類。我只是將相關的代碼粘貼到這個問題上,用戶也可以調用CopyPage過程來在運行時添加頁面。現在用戶也可以在頁面2(索引1)和n之間左右移動它們。

在我的主要模塊:

Public arrLeftButton() As New CButton 
Public arrRightButton() As New CButton 

在我的CButton類模塊:

Option Explicit 
Public WithEvents CopyButton As MSForms.CommandButton 
Public WithEvents DeleteButton As MSForms.CommandButton 
Public WithEvents MoveLeft As MSForms.CommandButton 
Public WithEvents MoveRight As MSForms.CommandButton 

Private Sub MoveLeft_Click() 
    Dim pag As MSForms.Page 
    Dim lngPageCount As Long 
    Set pag = UFmodproject.MultiPage1.SelectedItem 
    lngPageCount = UFmodproject.MultiPage1.Pages.Count 
    If pag.Index > 1 Then 
     pag.Index = pag.Index - 1 
    End If 
End Sub 

Private Sub MoveRight_Click() 
    Dim pag As MSForms.Page 
    Dim lngPageCount As Long 
    Set pag = UFmodproject.MultiPage1.SelectedItem 
    lngPageCount = UFmodproject.MultiPage1.Pages.Count 
    If pag.Index < lngPageCount - 1 Then 
     pag.Index = pag.Index + 1 
    End If 
End Sub 

而且我UserForm_Initialize:

Private Sub userform_initialize() 
    ReDim Preserve arrLeftButton(1 To 1) 
    ReDim Preserve arrRightButton(1 To 1) 
    Set arrLeftButton(1).MoveLeft = MultiPage1.Pages(1).Controls("MoveLeft1") 
    Set arrRightButton(1).MoveRight = MultiPage1.Pages(1).Controls("MoveRight1") 
    For i = 2 To GetINIString("Project", "NumberOfShipmentTypes", strINIPATH) 
     Call FormControls.CopyPage 
    Next 
End Sub 

然而,在其他標準模塊,所以可以從其他地方也被稱爲:

Sub CopyPage() 
    Dim l As Double, r As Double 
    Dim Ctrl As Control 
    Dim newCtrl As Object 
    Dim pCount As Long 
    pCount = UFmodproject.MultiPage1.Pages.Count 

    '[...add pages and copy all controls] 

    For Each newCtrl In UFmodproject.MultiPage1.Pages(pCount).Controls 
     If Left(newCtrl.Name, Len(newCtrl.Name) - 1) = "MoveLeft" Then 
      ReDim Preserve arrLeftButton(1 To pCount) 
      Set arrLeftButton(pCount).MoveLeft = newCtrl 
     End If 
     If Left(newCtrl.Name, Len(newCtrl.Name) - 1) = "MoveRight" Then 
      ReDim Preserve arrRightButton(1 To pCount) 
      Set arrRightButton(pCount).MoveRight = newCtrl 
     End If 
    Next 
End Sub