錯誤截斷表名稱時

Question

我使用的命名錶：

  arrayCollabName = Array("CBDeltaBlockStatus_SAP03_to_Delta01", "CBDeltaBlockStatus_SAP03_to_Delta02", "CBDeltaDeliveryInformation_SAP03_to_Delta01") 

      If Len(arrayCollabName(idx)) > 31 Then 
       ActiveSheet.Name = Left(arrayCollabName(idx), 31) 
      Else 
       ActiveSheet.Name = arrayCollabName(idx) 
      End If 

在陣列1，當名稱被截斷爲31個字符第二名稱相似，VB拋出的錯誤「無法紙張重命名與另一個工作表相同的名稱，引用的對象庫或Visualbasic引用的工作簿。「

什麼辦法可以做到這一點沒有錯誤並命名錶以及CBDeltaBlock_SAP03_to_Delta01和CBDeltaBlock_SAP03_to_Delta02或任何合適的名稱。

Answer 1

以下是更改工作表名稱（如果它已存在）的示例。

Option Explicit 

Sub Sample() 
    Dim i As Long 
    Dim strShName As String 

    strShName = "BlahBlah" 

    Sheets.Add 

    Do Until DoesSheetExist(strShName) = False 
     i = Int((1000 * Rnd) + 1) 
     strShName = strShName & i 
    Loop 

    ActiveSheet.Name = strShName 
End Sub 

Function DoesSheetExist(ByVal strSheetName As String) As Boolean 
    Dim ws As Worksheet 
    On Error Resume Next 
    Set ws = Sheets(strSheetName) 
    On Error GoTo 0 
    If Not ws Is Nothing Then DoesSheetExist = True 
End Function 

上述方法將在工作表末尾添加一個隨機數。如果你想增加順序，然後使用下面的代碼。

Option Explicit 

Sub Sample() 
    Dim i As Long 
    Dim strShName As String 

    strShName = "BlahBlah" 

    Sheets.Add 

    If DoesSheetExist(strShName) = True Then 
     i = 1 
     Do Until DoesSheetExist(strShName & i) = False 
      i = i + 1 
     Loop 
     strShName = strShName & i 
    End If 

    ActiveSheet.Name = strShName 
End Sub 

Function DoesSheetExist(ByVal strSheetName As String) As Boolean 
    Dim ws As Worksheet 
    On Error Resume Next 
    Set ws = Sheets(strSheetName) 
    On Error GoTo 0 
    If Not ws Is Nothing Then DoesSheetExist = True 
End Function 

注：上述代碼只是示例代碼。錯誤處理尚未納入上述代碼，不用說錯誤處理是必須的:)