Блог

Я использую подготовленный код VBA, который я скачал из Интернета.Код нуждается в некоторых изменениях, чтобы получить то, что мне нужно, одним из них является использование одного и того же имени для кода и листа в объектах Microsoft Excel, как показано на прилагаемом рисунке.

Как я могу использовать одно и то же имя для кода и листа, потому что я не могу перестать получать следующее сообщение «Недопустимое значение свойства», когда я использую одно и то же имя как для кода, так и для листа, зная, что я много раз видел, что мы можем использовать одно и то же имя.

Поскольку мы не смогли увидеть код, который вы используете, пожалуйста, попробуйте следующий Sub :

 Private Sub ChangeCodeName(sh As Worksheet, strCodeName As String)
  Dim shCModule As Object
  Set shCModule = ActiveWorkbook.VBProject.VBComponents(sh.CodeName)
  shCModule.Name = strCodeName
End Sub
 

Его следует назвать следующим образом:

 Sub testFunctionChangeCodeName()
   Dim sh As Worksheet
   Set sh = Worksheets("mySheet") 'of course, this sheet name must exist...
    ChangeCodeName sh, sh.Name
End Sub
 

Кодовые имена к Именам и Наоборот

• Каждое кодовое имя листа, за исключением зарезервированного ключевого history слова , является допустимым именем листа.
• С другой стороны, каждое имя листа не является допустимым кодовым именем листа.

 Option Explicit


Sub CodeNamesToNamesTEST()
    CodeNamesToNames ThisWorkbook
End Sub

Sub CodeNamesToNames( _
        ByVal wb As Workbook)
    If wb Is Nothing Then Exit Sub
    
    Const Dummy As String = "ZZZZ"
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sh As Object
    For Each sh In wb.Sheets
        dict(sh.Name) = sh.CodeName
    Next sh
    
    Dim proj As Object: Set proj = wb.VBProject
    
    Dim Key As Variant
    Dim n As Long
    Dim oName As String
    Dim nName As String
    Do
        For Each Key In dict.Keys
            If StrComp(Key, dict(Key), vbBinaryCompare) = 0 Then ' match
                dict.Remove Key
            Else ' not a match
                oName = dict(Key)
                On Error Resume Next
                proj.VBComponents(oName).Name = Key
                Select Case Err.Number
                Case 0
                    dict.Remove Key ' successfully renamed
                Case 32813 ' code name is taken
                    n = n   1
                    nName = Dummy amp; n
                    proj.VBComponents(oName).Name = nName
                    dict(Key) = nName
                Case 50132 ' invalid code name...
                    ' must start with [A-Za-z]
                    ' can only contain [A-Za-z0-9_]
                    dict.Remove Key ' ... cannot be renamed!
                End Select
                On Error GoTo 0
            End If
        Next Key
    Loop Until dict.Count = 0

End Sub


Sub NamesToCodeNamesTEST()
    NamesToCodeNames ThisWorkbook
End Sub

Sub NamesToCodeNames( _
        ByVal wb As Workbook)
    If wb Is Nothing Then Exit Sub
    
    Const Dummy As String = "#$%"
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sh As Object
    For Each sh In wb.Sheets
        dict(sh.CodeName) = sh.Name
    Next sh
    
    Dim Key As Variant
    Dim n As Long
    Dim oName As String
    Dim nName As String
    Do
        For Each Key In dict.Keys
            If StrComp(Key, dict(Key), vbBinaryCompare) = 0 Then ' match
                dict.Remove Key
            ElseIf StrComp(Key, "history", vbTextCompare) = 0 Then ' reserved...
                dict.Remove Key ' ... cannot be renamed!
            Else ' not a match
                oName = dict(Key)
                On Error Resume Next
                wb.Sheets(oName).Name = Key
                If Err.Number = 0 Then ' successfully renamed
                    dict.Remove Key
                Else ' name is taken, rename the existing sheet
                    If dict.Exists(oName) Then
                        n = n   1
                        nName = Dummy amp; n
                        wb.Sheets(oName).Name = nName
                        dict(Key) = nName
                    End If
                End If
                On Error GoTo 0
            End If
        Next Key
    Loop Until dict.Count = 0

End Sub
 

Проблема устранена, когда я изменил имя модуля POS на POS_Macros, я использовал одно и то же имя как для модуля, так и для кода листа, я думаю, что мы не должны использовать одно и то же имя для модуля и кодовое имя листа, связанное с рабочим листом.