2

テキストが列 A の任意の行に入力されるたびに、テンプレート スプレッドシートのコピーを作成するコードを開発しています。スプレッドシートは、入力されたテキストに基づいて名前を付ける必要があります。

現在、次のコードがあります。問題は、入力したテキストの後に新しいスプレッドシートの名前が付けられないことです。

コードは次のとおりです。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsNew As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub

    On Error Resume Next
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        Set wsNew = Sheets(Target.Text)
        If wsNew Is Nothing Then 
            Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
        End If
        'name new sheet code here

    End If
End Sub
4

2 に答える 2

0

目的の名前のテンプレートに基づいてシートを作成するには、このようなことをお勧めしますが、最初に提案されたシート名をテストしてクレンジングした後、無効な文字を探します

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsNew As Worksheet
    Dim strSht As String

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        On Error Resume Next
        Set wsNew = Sheets(Target.Text)
        On Error GoTo 0
        If wsNew Is Nothing Then
        If ValidSheetName(Target.Value) Then
        strSht = Target.Value
        Else
        strSht = CleanSheetName(Target.Value)
        End If
        End If
        Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = strSht
    End If
End Sub

ストリングクリーニングコード 1

Function ValidSheetName(strIn As String) As Boolean
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    objRegex.Pattern = "[\<\>\*\\\/\?|]"
    ValidSheetName = Not objRegex.test(strIn)
End Function

ストリングクリーニングコード 2

Function CleanSheetName(strIn As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "[\<\>\*\\\/\?|]"
        CleanSheetName = .Replace(strIn, "_")
    End With
End Function
于 2013-07-20T02:15:35.977 に答える
0

このような：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsNew As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub

    On Error Resume Next
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        Set wsNew = Sheets(Target.Text)
        If wsNew Is Nothing Then 
            Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
        End If
        'name new sheet
        Worksheets(Worksheets.Count).Name = Target.Text
    End If
End Sub

編集：

ユーザーは、「 Template (2)A1:A10 」という新しいタブを作成するセルを空にすることができます。また、チェックする必要があります：

If Len(Target.Cells.Text) = 0 Then Exit Sub
于 2013-07-19T05:02:35.063 に答える