Question

我有一个自定义功能区附加到模块“新的一天”

我想要的是避免重复的工作表名称错误，如果工作表名称已创建，则退出sub并添加msg“name aready exists”。

我的代码：

 Sub NewDay(control As IRibbonControl)

    Dim CopySheet As Long

    CopySheet = MsgBox("New Sheet", vbYesNo, "92x4-4xx9 xx INC")
    If CopySheet = vbNo Then Exit Sub
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet.Range("C1")
        .Parent.Name = Format(.Value, "mmm-dd-yyyy")
        Worksheets("Productions").Range("G6:G56").ClearContents
        Worksheets("Productions").Range("J6:J56").ClearContents
        Worksheets("Productions").Range("M6:O56").ClearContents
        Worksheets("Productions").Range("M63:N63").ClearContents
        Worksheets("Productions").Range("E59:Q59").ClearContents
        Range("C1") = Format(Date - 1)
        Sheets("Productions").Activate
        Productions.Range("G6").Select
        Range("C1") = Format(Date)
        End With

End Sub

Answer 1

Sub NewDay()

    Dim CopySheet As Long

    CopySheet = MsgBox("New Sheet", vbYesNo, "92x4-4xx9 xx INC")
    If CopySheet = vbNo Then Exit Sub
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet.Range("C1")
            Dim WS_Sheet As Worksheet
            On Error Resume Next
            Set WS_Sheet = Sheets(.Parent.Name = Format(.Value, "mmm-dd-yyyy"))
            On Error GoTo 0

            If WS_Sheet Is Nothing Then ' Worksheet did not exist
                .Parent.Name = Format(.Value, "mmm-dd-yyyy")
                Worksheets("Productions").Range("G6:G56").ClearContents
                Worksheets("Productions").Range("J6:J56").ClearContents
                Worksheets("Productions").Range("M6:O56").ClearContents
                Worksheets("Productions").Range("M63:N63").ClearContents
                Worksheets("Productions").Range("E59:Q59").ClearContents
                Range("C1") = Format(Date - 1)
                Sheets("Productions").Activate
                Productions.Range("G6").Select
                Range("C1") = Format(Date)
            Else ' Worksheet exists
                ' Handle the problem here
            End If
        End With
End Sub

Answer 2

构建一个陷阱和处理错误的例程。以下是如何执行此操作的示例：

Sub SheetError()
    Dim MySheet As String
    On Error GoTo ErrorCheck
    MySheet = ActiveSheet.Name
    Sheets.Add
    ActiveSheet.Name = MySheet
    MsgBox "I continued the code"
    Activsheet.Name = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    MsgBox "I will never get to here in the code"
    End
ErrorCheck:
    If Err.Description = "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic." Then
        Resume Next
    Else
        MsgBox "Error I am not designed to deal with"
    End If
End Sub

Answer 3

Thx家伙我找到了我需要的东西。

<!-- Some irrelevant Bootstrap navbar code before this -->
<div class="navbar-header">
  <a class="navbar-brand <%= 'active' if current_page?(root_path) %>" href="/">My Company Text</a>
</div>

<!-- ... More navbar code ... -->
<!-- A drop-down with a Font Awesome icon example below -->
<ul class="dropdown-menu">
  <li>
    <%= link_to home_dashboard_path, class: 'user' do %>
      <i class="fa fa-tachometer">&nbsp;</i>My Dashboard
    <% end %>
  </li>
</ul>

避免重复工作表名称错误

3 个答案: