错误截断表名称时

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 

注：上述代码只是示例代码。错误处理尚未纳入上述代码，不用说错误处理是必须的:)