布爾型數組和變體類型vba

當將boolean（）數組傳遞給變體類型（變體類型駐留在類模塊中）時，我得到意想不到的結果。我希望得到一個真實的價值，但我接受錯誤。我所提供的代碼片段下面的評論布爾型數組和變體類型vba

Private Sub validateEmployee(ByVal employeeCollection As collection) 


Dim ws As Worksheet 
Dim emp As Employee 
Dim empID As Integer 
Dim cell As String 
Dim errors() As Boolean 
Dim idx As Long 
Dim arr() As String 
Dim cell_address() As String 

Dim flag_array() As Boolean 
Dim m As Integer 
Dim valid_flag As Boolean 
Dim counter As Integer 
Dim output As String 

Sheet1.unProtectWS "x" 

Set ws = Worksheets("x") 

ws.Select 
With Selection 

    For Each emp In employeeCollection 

     empID = empID + 1 

     'Debug.Print ("validation runs... for emp: " & empID) 

     'validate all fields within Employee Object 
     'if invalid field exists colour it red 
     'set global error flag to ensure no worksheet gets printed 

     '###################################################### 
     'START Header Section 
     '###################################################### 

     'year 
     cell = emp.getJournalYearCell 
     idx = 1 
     ReDim errors(idx) 

     If emp.getJournalYear = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'region 
     cell = emp.getRegionCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getRegion = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'district 
     cell = emp.getDistrictCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getDistrict = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'journal number 
     cell = emp.getJournalNumberCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getJournalNumber = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     '###################################################### 
     ' END Header Section 
     '###################################################### 


     '######################### 
     'START Employee Line Items 
     '######################### 

     'employee name 
     cell = emp.getNameCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getName = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'classification code 
     cell = emp.getClassCodeCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getClassCode = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'hourly rate 
     cell = emp.getHourlyRateCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getHourlyRate = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'certification number 
     cell = emp.getCertNumberCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getCertNumber = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'employee day 
     cell = emp.getEDayCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getDay = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'employee month 
     cell = emp.getEMonthCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getMonth = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'employee year 
     cell = emp.getEYearCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getEYear = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'cheque number 
     cell = emp.getChequeNoCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getChequeNo = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'mailing address field 1 
     cell = emp.getAddress1Cell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getAddress1 = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'mailing address field 2 
     cell = emp.getAddress2Cell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getAddress2 = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     '**************************** 
     'START SIN 
     '**************************** 


     'sin or treaty dropdown 
     cell = emp.getSinOrTreatyAddress 
     idx = idx + 1 
     ReDim errors(idx) 





     'fetch ssn array 
     arr = emp.getSSN 

     'fetch ssn cell address range 
     cell_address = emp.getSSN_cells 

     If emp.getSinOrTreaty = "" Or emp.getSinOrTreaty = "sin" Then 

      Dim str As String 
      Dim i As Integer 
      Dim c As String 

      Dim flag As Boolean 

      'toggle sinOrTreaty dropdown menu 
      If emp.getSinOrTreaty = "" Then 
       Range(cell).Interior.Color = RGB(255, 0, 0) 
      Else 
       Range(cell).Interior.Color = RGB(255, 255, 255) 
      End If 


      For i = LBound(arr) To UBound(arr) 
       str = str & arr(i) 
      Next i 
      'Debug.Print (str) 

      'return overall result ie. valid or invalid SIN 
      'if sin is not valid, return false in this circumstance 
      flag = Utility.Verify_SIN(str) 
      'Debug.Print (flag) 



      If flag = False Then 
       'SIN invalid 
       errors(idx) = True 
       'emp.SetFlag idx, True 

       'set range 
       Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 0, 0) 

      Else 
       errors(idx) = False 
       'emp.SetFlag idx, False 
       Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255) 
      End If 

     Else 
      'treaty number is not validated 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell_address(1), cell_address(9)).Interior.Color = RGB(255, 255, 255) 
     End If 

     '**************************** 
     'END SIN 
     '**************************** 


     '######################### 
     'END Employee Line Items 
     '######################### 


     '######################### 
     'START FOOTER SECTION 
     '######################### 

     'prepared by field 
     cell = emp.getPreparedByCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getPreparedBy = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     'print name field 
     cell = emp.getPrintedNameCell 
     idx = idx + 1 
     ReDim errors(idx) 

     If emp.getPrintedName = "" Then 
      errors(idx) = True 
      'emp.SetFlag idx, True 
      Range(cell).Interior.Color = RGB(255, 0, 0) 
     Else 
      errors(idx) = False 
      'emp.SetFlag idx, False 
      Range(cell).Interior.Color = RGB(255, 255, 255) 
     End If 

     '######################### 
     'END FOOTER SECTION 
     '######################### 

     '########################## 
     'Validate Commissary Amount 
     '########################## 

     emp.setErrors = errors 



     'check errors, true is not found but why 
     Dim y As Long 
     y = 0 



     For y = 0 To 17 
      Debug.Print (emp.hasErrors()(y)) 

      If emp.hasErrors()(y) = True Then 
       valid_flag = False 
       'exit on first error thrown 
       Exit For 
      Else 
       'set marker 
       valid_flag = True 
      End If 
     Next y 


     flag_array = emp.hasErrors 


    Next emp 




End With 

'################### 
'Create worksheet 
'################### 

'idea; create only valid worksheets ie. only send valid worksheets for printing 

For Each emp In employeeCollection 

    flag_array = emp.hasErrors 

    For m = LBound(flag_array) To UBound(flag_array) 

     If (flag_array(m) = True) Then 
      'exit on first error thrown 
      Exit For 
     Else 
      'set marker 
      valid_flag = True 
      counter = counter + 1 
     End If 

    Next m 

Next emp 


'worksheet free from validation errors 
If (valid_flag = True And empID = 15) Then 
    createWS employeeCollection 
Else 
    output = "worksheet contains errors, please correct fields in red." 
    MsgBox (output) 
End If 




Sheet1.protectWS "x"

末次

來源

2015-09-01 Michael

爲什麼不把它作爲布爾？ – MatthewD

實際問題是什麼？你沒有給出太多的上下文。 –

'flag_array = emp.hasErrors'這不能在子/函數之外。 –

的編輯：在爲SetFlag代碼我現在創建或擴展的陣列如果需要的話。

的問題是，Get返回私有數組的副本 - 所以在使用類的代碼改變私人陣列，而不是私人陣列本身的副本。解決方法是提供訪問數組的方法。例如，在你的類定義添加這個（我不知道類的名稱，以便我把它Employee）：

Public Sub SetFlag(i As Long, b As Boolean) 
    If Not IsArray(errors) Then 
     ReDim errors(0 To i) As Boolean 
    ElseIf UBound(errors) < i Then 
     ReDim Preserve errors(LBound(errors) To i) As Boolean 
    End If 
    errors(i) = b 
End Sub 

Public Function GetFlag(i As Long) As Boolean 
    GetFlag = errors(i) 
End Function

測試子：

Sub test() 
    Dim b(1 To 4) As Boolean 
    Dim e As New Employee 
    b(1) = False 
    b(2) = True 
    b(3) = True 
    b(4) = False 

    e.setErrors = b 
    Debug.Print e.hasErrors()(3) 'prints True 
    e.hasErrors()(3) = False 
    Debug.Print e.hasErrors()(3) '*Still* prints True 

    'but: 
    e.SetFlag 3, False 
    Debug.Print e.hasErrors()(3) 'now prints False 
    'or just: 
    Debug.Print e.GetFlag(3) 'Prints False 
End Sub

來源

2015-09-01 17:35:37

感謝John等人提供意見。然而，我現在得到了一個類型不匹配的錯誤emp.SetFlag idx，False和你上面提供的代碼片斷。我有僱員類中的屬性作爲私人錯誤作爲Variant可以拋出的錯誤，應該被聲明爲類型布爾數組呢？基本上我的源代碼（爲清楚起見，我省略了大部分代碼）1.填充一個vba bean（帶有值的vba對象）2.驗證僱員對象。 3. Last根據每個員工驗證的標準打印工作表，即。沒有錯誤。 – Michael

如何？我的示例代碼顯示，可以將一個布爾數組存儲在一個類的私有變體中，並且可以提供訪問方法來讀取和寫入該數組的元素。你究竟想用這個私有數組做什麼？您提供的代碼片段並不完整。首先 - 在代碼片段中，你永遠不會初始化「錯誤」，並且你有一些片段似乎被未知的潛艇或功能所剝奪。 –

我想我看到了問題。如果你沒有使用'setErrors'給'errors>一個值，那麼'SetFlag'會給出一個類型不匹配 - 因爲它將一個空變量看作是一個數組。 'SetFlag'不創建*數組 - 它允許您更改現有數組的值。如果需要，可以更改代碼以便創建（或擴展）數組 - 儘管也許您可能需要私有集合而不是私有數組 –

布爾型數組和變體類型vba

回答

相關問題