Jdi na obsah Jdi na menu
Reklama
Založte webové stránky zdarma - eStránky.cz
 


Nepovolené znaky

2. 8. 2008
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řidat komentář

Přehled komentářů

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