excel

Option Explicit

Public Function ConvertCzechChars(sInput As String) As String
    Dim i As Long, sRes As String, ch As String
    sRes = ""
    For i = 1 To Len(sInput)
        ch = Mid(sInput, i, 1)
        Select Case ch
            Case "é": sRes = sRes & "0"
            Case "ž": sRes = sRes & "6"
            Case "ý": sRes = sRes & "7"
            Case "+": sRes = sRes & "1"
            Case "ř": sRes = sRes & "5"
            Case "á": sRes = sRes & "8"
            Case "í": sRes = sRes & "9"
            Case "č": sRes = sRes & "4"
            Case "ě": sRes = sRes & "2"
            Case "š": sRes = sRes & "3"
            Case "=": sRes = sRes & "-"  ' Oprava: při české klávesnici se "=" má převést na "-"
            Case Else: sRes = sRes & ch
        End Select
    Next i
    ConvertCzechChars = sRes
End Function

' Funkce, která vytvoří klíč z kódu podle jeho délky:
'  - U 26-znakových kódů s "P" se vezme prvních 16 znaků
'  - U 26-znakových bez "P" se vezme prvních 10 znaků
'  - U 31-znakových se vezme prvních 11 znaků
Private Function GetKey(kod As String) As String
    kod = Trim(kod)
    Select Case Len(kod)
        Case 26
            If Left(kod, 1) = "P" Then
                GetKey = UCase(Left(kod, 16))
            Else
                GetKey = UCase(Left(kod, 10))
            End If
        Case 31
            GetKey = UCase(Left(kod, 11))
        Case Else
            GetKey = ""
    End Select
End Function

' Funkce pro rozpoznání názvu dílu podle slovníku
Public Function RozpoznejDMC(kod As String) As String
    Dim d As Object, key As String
    key = GetKey(kod)
    Set d = GetDataDict()
    If d.Exists(key) Then
        RozpoznejDMC = d(key)(0)
    Else
        RozpoznejDMC = "Neznámý kód"
    End If
End Function

' Funkce pro získání čísla materiálu
Public Function ExtractKod(kod As String) As String
    Dim d As Object, key As String
    key = GetKey(kod)
    Set d = GetDataDict()
    If d.Exists(key) Then
        ExtractKod = d(key)(1)
    Else
        ExtractKod = "Neznámé"
    End If
End Function

' Funkce pro získání pořadí – dle délky kódu (příklad)
Public Function ExtractPoradi(kod As String) As String
    Select Case Len(kod)
        Case 26
            If Left(kod, 1) = "P" Then
                ExtractPoradi = Right(kod, 4)
            Else
                ExtractPoradi = Mid(kod, 18, 4)
            End If
        Case 31
            ExtractPoradi = Mid(kod, 20, 4)
        Case Else
            ExtractPoradi = ""
    End Select
End Function

' Funkce pro získání data z kódu
Public Function ExtractDatum(kod As String) As Variant
    Dim rok As Integer, den As Integer, maxDay As Integer, d As Date
    Dim sRok As String, sDen As String
    On Error GoTo ErrorHandler
    
    Select Case Len(kod)
        Case 26
            If Left(kod, 1) = "P" Then
                sRok = Trim(Mid(kod, 20, 2))
                sDen = Trim(Mid(kod, 17, 3))
                If Not IsNumeric(sRok) Or Not IsNumeric(sDen) Then
                    ExtractDatum = ""
                    Exit Function
                End If
                rok = CInt(sRok) + 2000
                den = CInt(sDen)
            Else
                sRok = Trim(Right(kod, 2))
                sDen = Trim(Mid(kod, 22, 3))
                If Not IsNumeric(sRok) Or Not IsNumeric(sDen) Then
                    ExtractDatum = ""
                    Exit Function
                End If
                rok = CInt(sRok) + 2000
                den = CInt(sDen)
            End If
        Case 31
            sRok = Trim(Mid(kod, 12, 2))
            sDen = Trim(Mid(kod, 15, 3))
            If Not IsNumeric(sRok) Or Not IsNumeric(sDen) Then
                ExtractDatum = ""
                Exit Function
            End If
            rok = CInt(sRok) + 2000
            den = CInt(sDen)
        Case Else
            ExtractDatum = ""
            Exit Function
    End Select
    
    maxDay = DateSerial(rok, 12, 31) - DateSerial(rok, 1, 1) + 1
    If den > maxDay Then
        ExtractDatum = ""
        Exit Function
    End If
    
    d = DateSerial(rok, 1, den)
    ExtractDatum = d
    Exit Function
ErrorHandler:
    ExtractDatum = ""
End Function