Elektroda.pl
Elektroda.pl
X

Search our partners

Find the latest content on electronic components. Datasheets.com
Elektroda.pl
Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

[Solved] Generowanie kodu kreskowego w Excelu błąd podczas generowania

08 Feb 2020 13:12 1875 8
  • Level 12  
    Potrzebuję wygenerować kod kreskowy tak jak w arkuszu poniżej kod jest dość długi, użyłem codowania 128 zgodnie z instrukcją zamieściłem makro niestety nie działa coś jak należy potrzebuję pilnie wykonać taki generator kodów do pracy na poniedziałek i tu zaczęło się sypać
    czy ktoś by mógł pomóc bo siedzę nad tym już 3 godzinę i lipa
    W załączniku arkusz i czcionka z kodem kreskowym

    Code:
    Public Function code128$(chaine$)
    
      'This function is governed by the GNU Lesser General Public License (GNU LGPL)
     'V 2.0.0
     'Parameters : a string
     'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
     '         * an empty string if the supplied parameter is no good
     Dim i%, checksum&, mini%, dummy%, tableB As Boolean
      code128$ = ""
      If Len(chaine$) > 0 Then
      'Check for valid characters
       For i% = 1 To Len(chaine$)
          Select Case Asc(Mid$(chaine$, i%, 1))
          Case 32 To 126, 203
          Case Else
            i% = 0
            Exit For
          End Select
        Next
        'Calculation of the code string with optimized use of tables B and C
       code128$ = ""
        tableB = True
        If i% > 0 Then
          i% = 1 'i% devient l'index sur la chaine / i% become the string index
         Do While i% <= Len(chaine$)
            If tableB Then
              'See if interesting to switch to table C
             'yes for 4 digits at start or end, else if 6 digits
             mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
              GoSub testnum
              If mini% < 0 Then 'Choice of table C
               If i% = 1 Then 'Starting with table C
                 code128$ = Chr$(205)
                Else 'Switch to table C
                 code128$ = code128$ & Chr$(199)
                End If
                tableB = False
              Else
                If i% = 1 Then code128$ = Chr$(204) 'Starting with table B
             End If
            End If
            If Not tableB Then
              'We are on table C, try to process 2 digits
             mini% = 2
              GoSub testnum
              If mini% < 0 Then 'OK for 2 digits, process it
               dummy% = Val(Mid$(chaine$, i%, 2))
                dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
                code128$ = code128$ & Chr$(dummy%)
                i% = i% + 2
              Else 'We haven't 2 digits, switch to table B
               code128$ = code128$ & Chr$(200)
                tableB = True
              End If
            End If
            If tableB Then
              'Process 1 digit with table B
             code128$ = code128$ & Mid$(chaine$, i%, 1)
              i% = i% + 1
            End If
          Loop
          'Calculation of the checksum
         For i% = 1 To Len(code128$)
            dummy% = Asc(Mid$(code128$, i%, 1))
            dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
            If i% = 1 Then checksum& = dummy%
            checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
          Next
          'Calculation of the checksum ASCII code
         checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 100)
          'Add the checksum and the STOP
         code128$ = code128$ & Chr$(checksum&) & Chr$(206)
        End If
      End If
      Exit Function
    testnum:
      'if the mini% characters from i% are numeric, then mini%=0
     mini% = mini% - 1
      If i% + mini% <= Len(chaine$) Then
        Do While mini% >= 0
          If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
          mini% = mini% - 1
        Loop
      End If
    Return
    End Function
    Czy Twoje urządzenia IoT są bezpieczne? [Webinar 22.06.2021, g.9.00]. Zarejestruj się za darmo
  • Level 37  
    rafal24s wrote:
    siedzę nad tym już 3 godzinę i lipa

    Rozumiem, że na początku swego "posiedzenia" zainstalowałeś tą czcionkę i zresetowałeś offica i komputer :?: :idea:
    Po takim działaniu Twój plik wydruku (ten z poprzedniego wątku) realizował by wszystko co potrzebujesz po ustawieniu w komórce A10 czcionki Code128 :D
    Generowanie kodu kreskowego w Excelu błąd podczas generowania2020-02...png Download (43.66 kB)
  • Level 12  
    Tak, oczywiście cały czas takie coś : Generowanie kodu kreskowego w Excelu błąd podczas generowania
  • Level 12  
    niestety wtedy skaner wogule nie widzi kodu
  • Level 38  
    ZTCP *kod* = valid barcode
  • Level 12  
    tronics wrote:
    ZTCP *kod* = valid barcode

    mógłbyś wyjaśnić bo sie zgubiłem
  • Helpful post
    Level 38  
    Z Tego Co Pamiętam generowanie barcode z tekstu wymaga znaków start/stop na początku i na końcu, dla code39 na 99,9% były asteriski (*) Dla Code128 może być inny, nie pamiętam, strona
    https://support.idautomation.com/Barcode-Font...round-my-data-for-all-barcode-font-types/_587
    sugeruje odpowiednie znaki specjalne. Innymi słowy to co chcesz by było zakodowane w barcode musi mieć doklejone znaki specjalne na początku i końcu by były rozpoznawane przez skaner.
  • Level 12  
    do wklejenia kod :
    Code:
    Public Function code128$(chaine$)
    
    'This function is governed by the GNU Lesser General Public License (GNU LGPL)
    'V 2.0.0
    'Parameters : a string
    'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
    '         * an empty string if the supplied parameter is no good
        Dim i%, checksum&, mini%, dummy%, tableB As Boolean
        code128$ = ""
        If Len(chaine$) > 0 Then
            'Check for valid characters
            For i% = 1 To Len(chaine$)
                Select Case AscW(Mid$(chaine$, i%, 1))
                    Case 32 To 126, 203
                    Case Else
                        i% = 0
                        Exit For
                End Select
            Next
            'Calculation of the code string with optimized use of tables B and C
            code128$ = ""
            tableB = True
            If i% > 0 Then
                i% = 1                     'i% devient l'index sur la chaine / i% become the string index
                Do While i% <= Len(chaine$)
                    If tableB Then
                        'See if interesting to switch to table C
                        'yes for 4 digits at start or end, else if 6 digits
                        mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
                        GoSub testnum
                        If mini% < 0 Then  'Choice of table C
                            If i% = 1 Then    'Starting with table C
                                code128$ = ChrW(205)
                            Else           'Switch to table C
                                code128$ = code128$ & ChrW(199)
                            End If
                            tableB = False
                        Else
                            If i% = 1 Then code128$ = ChrW(204)    'Starting with table B
                        End If
                    End If
                    If Not tableB Then
                        'We are on table C, try to process 2 digits
                        mini% = 2
                        GoSub testnum
                        If mini% < 0 Then  'OK for 2 digits, process it
                            dummy% = Val(Mid$(chaine$, i%, 2))
                            dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
                            code128$ = code128$ & ChrW(dummy%)
                            i% = i% + 2
                        Else               'We haven't 2 digits, switch to table B
                            code128$ = code128$ & ChrW(200)
                            tableB = True
                        End If
                    End If
                    If tableB Then
                        'Process 1 digit with table B
                        code128$ = code128$ & Mid$(chaine$, i%, 1)
                        i% = i% + 1
                    End If
                Loop
                'Calculation of the checksum
                For i% = 1 To Len(code128$)
                    dummy% = AscW(Mid$(code128$, i%, 1))
                    dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
                    If i% = 1 Then checksum& = dummy%
                    checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
                Next
                'Calculation of the checksum ASCII code
                checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 100)
                'Add the checksum and the STOP
                code128$ = code128$ & ChrW(checksum&) & ChrW(206)
            End If
        End If
        Exit Function
    testnum:
        'if the mini% characters from i% are numeric, then mini%=0
        mini% = mini% - 1
        If i% + mini% <= Len(chaine$) Then
            Do While mini% >= 0
                If AscW(Mid$(chaine$, i% + mini%, 1)) < 48 Or AscW(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
                mini% = mini% - 1
            Loop
        End If
        Return
    End Function