Nepovolené znaky
Dnes jsem potřeboval napsat kód na odstranění nepovolených znaků z předaného řetězce který měl sloužit pro pojmenování listů. Jak asi víte max. délka znaků pro pojmenování listu je 31 a zároveň nemůže být název listu prázdný. Nepovolené znaky pro pojmenování listů v Excelu jsou - „ : \ / ? * [ ] ' “
Jelikož jsem na webu nenašel přesně to co bych potřeboval, napsal jsem si vlastní funkci, která zvládá veškeré požadavky na správné a korektní pojmenování listu. Zvažoval jsem, že dopíšu kontrolu na stejný název listu v sešitě kde se list přejmenovává, ale jelikož jsem zrovna tuhle nefunkčnost nepožadoval, tak sem ji záměrně vynechal.
'!!!!!!!!!!!!!!!!!!!!!!!!!! Begin Comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Comments: Nahradi v predanem retezci nepovolene znaky.Take kontroluje
' max a min pocet znaku v predanem retezci.
' Vraci ocistene jmeno s kontrolou pro zadani
'
' Arguments: sRetezec - retezec pro ocisteni od nepovolenych znaku
'
' Call: AnalyzaZpracovani
'
' Date Developer Action
' ------------------------------------------------------------------------------------
' 02.08.2008 Premysl Lazecky Create code
Function ReplaceIllegalChar(sRetezec As String) As String
Const bytMAX_LENGHT As Byte = 30
Const sREPLACE_CHAR As String = "_"
Dim sillegalCharacters
Dim i As Byte
sillegalCharacters = Array("?", "\", "*", "/", "]", "[", "'", ":")
If Len(sRetezec) > bytMAX_LENGHT Then
sRetezec = Left(sRetezec, bytMAX_LENGHT)
ElseIf Len(sRetezec) = 0 Then
sRetezec = sREPLACE_CHAR
End If
' odstraneni illegal characters
For i = 0 To UBound(sillegalCharacters)
sRetezec = Replace(Expression:=sRetezec, _
Find:=sillegalCharacters(i), _
Replace:=sREPLACE_CHAR)
Next i
ReplaceIllegalChar = sRetezec
End Function
Komentáře
Přehled komentářů
Good info. Cheers.
reliable essay writing service https://essayservicehelp.com custom assignment writing service https://helpmedomyxyzhomework.com
Nepovolené znaky
(Jirka, 17. 3. 2014 9:54)
Děkuji za ošetření neplatných znaků. Jsi jednička!!! Trochu jsem si to upravil, aby se mi automaticky vytvořily listy podle označené oblasti:
Sub Vytvorit_listy_sesitu()
'
' Vytvorit_listy_sesitu
'
Set myRange = Application.InputBox(prompt:="Zadejte vstupní oblast dat (data musí být ve sloupci):", _
Title:="Dle zadané oblasti budou vytvoreny nové listy", _
Type:=8)
myRange.Select ' Nastaví oblast se vstupními daty
Dim sRetezec As String
Dim Bunka As Range
Dim bool As Byte
Dim i As Byte
Const bytMAX_LENGHT As Byte = 30
Const sREPLACE_CHAR As String = "_"
Dim sillegalCharacters
sillegalCharacters = Array("?", "\", "*", "/", "]", "[", "'", ":")
For Each Bunka In Selection ' Nacte postupne vsechny bunky z oblasti
sRetezec = Bunka ' Presune nacetenou bunku do sRetezec, aby se bunka neprepisovala
bool = 1
If Len(sRetezec) > bytMAX_LENGHT Then ' Zkopirovano od kolegy
sRetezec = Left(sRetezec, bytMAX_LENGHT)
ElseIf Len(sRetezec) = 0 Then
sRetezec = sREPLACE_CHAR
End If
' odstraneni illegal characters
For i = 0 To UBound(sillegalCharacters)
sRetezec = Replace(Expression:=sRetezec, _
Find:=sillegalCharacters(i), _
Replace:=sREPLACE_CHAR)
Next i
For i = 1 To Sheets.Count ' Zkontroluje jestli uz nove vytvárena bunka existuje a nastaví bool na 0
If Sheets(i).Name = sRetezec Then MsgBox "List " & sRetezec & " už existuje a nebude vytvoren"
If Sheets(i).Name = sRetezec Then bool = 0
Next i
Application.DisplayAlerts = False ' Vytvori nový list
If bool = 1 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = sRetezec
Next Bunka
End Sub
how to write an exploratory essay z20ion
(EugeneCex, 6. 4. 2023 19:41)