• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Barcode invoegen in Excel via VBA of Powerquery?

Status
Niet open voor verdere reacties.

Georgyboy

Terugkerende gebruiker
Lid geworden
6 jan 2007
Berichten
1.020
Besturingssysteem
Windows 11
Office versie
365
Beste allen,

Heb een super werkende code (dank aan Pitufo) sinds enkele jaren en ondertussen ook office 365.
Graag zou ik een barcode willen invoegen in kolom H van gegevens in kolom C.
Kan dit in de code worden verwerkt? of zijn er andere mogelijkheden?

Code staat achter het 1° tabblad en komt in tabblad "tabel"

Sub maak_tabel()

Application.ScreenUpdating = False
Dim t As Worksheet
Set t = Sheets("Tabel")
t.[a1] = "Locatie"
t.[b1] = "Partij / charge"
t.[c1] = "Nummer"
t.[d1] = "Art.nr."
t.[e1] = "Naam lang"
t.[f1] = "stuks"
t.[g1] = "kg"
doel = 2

rijen = Cells(Rows.Count, 1).End(xlUp).Row
r = 1
While LCase(Left(Cells(r, 1), 7)) <> "locatie"
r = r + 1
Wend

For rij = r To rijen
tekst = Cells(rij, 1)
If Trim(tekst) <> "" Then
If LCase(Left(tekst, 7)) = "locatie" Then
Locatie = Trim(tekst)
Else
If IsNumeric(Mid(tekst, 15, 1)) Then
artnr = Mid(tekst, 15, 7)
naam = Trim(Mid(tekst, 23, 29))
Else
If LCase(Mid(tekst, 23, 6)) = "partij" Or LCase(Mid(tekst, 23, 6)) = "charge" Then
pc = LCase(Mid(tekst, 23, 6))
nr = Mid(tekst, 31, 5)
stuks = Trim(Mid(tekst, 92, 8))
kg = CDbl(WorksheetFunction.Substitute(Trim(Mid(tekst, 100, 12)), ".", ","))
t.Cells(doel, 1) = Locatie
t.Cells(doel, 2) = pc
t.Cells(doel, 3) = nr
t.Cells(doel, 4) = artnr
t.Cells(doel, 5) = naam
t.Cells(doel, 6) = stuks
t.Cells(doel, 7) = kg
doel = doel + 1
End If
End If
End If
End If
Next rij
t.Columns("G").NumberFormat = "0.000"
t.Columns("A:G").EntireColumn.AutoFit

End Sub

Alvast bedankt!
 

Bijlagen

Gewijzigde met font 3 of 9 barcode font
1701027326665.png

Zou dit ook via de vba code automatisch kunnen?
Helaas kan ik deze codes niet inscannen via telefoon "scannen"
probeer het morgen via een scanner......
 

Bijlagen

In jouw tabel is een aantal nummers niet goed overgenomen. (bijv. koppel bouten 43601 in plaats van 436011647
Maar wat een ratjetoe (ratatouille) in dat exportbestand.
Ik zou de gegevens rechtstreeks uit het txt-bestand importeren in het werkblad:

CSS:
Sub M_snb()
  sn = Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\0_Voorraad.txt").readall, vbCrLf), " ")
  ReDim sp(UBound(sn), 7)
 
  For j = 8 To UBound(sn)
    If Left(sn(j), 1) = "L" Then
      c00 = Mid(sn(j), 10)
    ElseIf InStr(sn(j), "_") Then
      st = Split(Application.Trim(Replace(sn(j), "_", "")))
      For jj = 0 To UBound(sp, 2)
        sp(n, jj) = Choose(jj + 1, c00, Replace(st(0), ":", ""), st(1), c02, c01, st(UBound(st) - 1), --st(UBound(st)), st(1))
      Next
      n = n + 1
    Else
      c01 = Mid(sn(j), 15)
      c02 = Val(c01)
      c01 = Mid(c01, 8, InStr(c01, "  ") - 8)
    End If
  Next
 
  Sheet1.Cells(1).Resize(, 6) = Split("Lokatie Partij/Charge Nummer art.nr. Naam stuks kg")
  Sheet1.Cells(2, 1).Resize(UBound(sp), UBound(sp, 2) + 1) = sp
  Sheet1.Columns(8).Font.Name = "Code 128"
End Sub
 
Laatst bewerkt:
nu met bestand.
De code in de codemodule van sheet1
Zorg eerst dat het tekstbestand ergens staat en de verwijzing ernaar in de eerste regel van de makro klopt.

PS. Excel kan gemakkelijk gekoppeld worden aan de database waaruit nu de gegevens eerst worden geëxporteerd.
 

Bijlagen

Bedankt snb voor je goed werkende code,
Bedankt ook voor de andere tips!
Heb moeite om ze helemaal te begrijpen, maar ben er zéér blij mee!
Denk dat deze code zo kort mogelijk is geschreven?

Mag ik een variant vragen zoals in tabblad "Gewenst"?
Echter de rijhoogte is hier 81 wat véél papier vergt,
wat is de minimum hoogte die we kunnen gebruiken om toch de barcode te kunnen lezen?

is het beter om het TXT bestand op te zoeken de de map waar deze bevind?
Hier uit de map "\\mc-fp01\userdoc$\G\My Documents\Voorraad



Mc NV - Mc NV, dRtum: 28 nZvember 2023 (11:32), fZrmulBer: 289, gebruBker: GD, pRgBnR 1
======================================================================
Voorraad tellijst
Voorraadlocatie : FRIGO CHAR
Inkoopgroep : Geen selecties gemaakt
Leverancier : Geen selecties gemaakt
Artikel : 14 selecties gemaakt
Inkoop productiegroep : Geen selecties gemaakt
-----------------------------------------------------------------------
Pick locatie Art.Nr. Naam lang Merk Verpakking
======================================================================

Locatie: FRIGO CHAR (51)
0 80091000 PBC NBC HRM G MECZ
PARTIJ: 26760353 Extern: 0 485,000 __________ __________
PARTIJ: 26765728 Extern: 0 1248,000 __________ __________
ch02 80701000 RZZKSPEK ENKEL GEHEEL 2KG G MECZ
PARTIJ: 26763035 Extern: 69 137,000 __________ __________
ch02 80703000 ZZUTSPEK ENKEL GEHEEL +/- 2KG G MECZ
PARTIJ: 26763831 Extern: 133 537,000 __________ __________
ch03 80012000 GRBLLBRCZN GEHEEL 2KG G MECZ
PARTIJ: 26750576 Extern: 19 39,000 __________ __________
ch03 80108000 BRCZN GERZZKT GEHEEL 2.8 KG G MECZ
PARTIJ: 26750740 Extern: 24501701 18 51,000 __________ __________
ch03 80109000 FBLET DE SRXE GEHEEL 1.8KG G HRVR
PARTIJ: 26501079 Extern: 0 -0,084 __________ __________
PARTIJ: 26760392 Extern: 33 60,000 __________ __________
ch04 80207000 FBLET D RNVERS GERZZKT GEHEEL+/- G MECZ
PARTIJ: 26746394 Extern: 30 60,000 __________ __________
ch04 80710001 HESPENSPEK GEZZUTEN GEHEEL G MECZ
PARTIJ: 26761497 Extern: 0 150,000 __________ __________
PARTIJ: 26761499 Extern: 0 142,000 __________ __________
ch12 80608000 FRBCRNDZN GEHEEL 2,5 KG G MECZ
PARTIJ: 26762945 Extern: 34 84,354 __________ __________
PARTIJ: 26765537 Extern: 74 185,000 __________ __________
ch12 80615000 FRBCRNDZN GEVZGELTE+PRPRBKR GEHE G MECZ
PARTIJ: 26753234 Extern: 25 54,746 __________ __________
PARTIJ: 26762943 Extern: 128 288,000 __________ __________
ch13 80709000 MZSTERDSPEK GEHEEL 2KG G MECZ
PARTIJ: 26747231 Extern: 29 58,000 __________ __________
PARTIJ: 26750735 Extern: 24 48,000 __________ __________
PARTIJ: 26764452 Extern: 66 132,480 __________ __________


Alvast Bedankt!
Groeten, Georgyboy
 

Bijlagen

  • Leuk hoe deze code werkt,
    kan de code nog met wat aanpassing uit een map waar we het TXT bestand kunnen zoeken?
  • Kan het document ook nog wat aangepast worden voor papierbesparing en toch een leesbare in te scannen barcode?

Alvast bedankt voor deze weer Top antwoorden op deze Topic!
 
Goedemorgen,

Had een fout gemaakt bij het testen om het document aan te passen.

'Foute Code loopt vast op
'c01 = Mid(c01, 8, InStr(c01, " ") - 8)

Sub M_snb_1()
sn = Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("C:\Users\Ge\Doc\Doc\GE\Forum Helpmij - Worksheet\VBA Codes\VrdNieuw.txt").readall, vbCrLf), " ")
ReDim sp(UBound(sn), 7)

For j = 8 To UBound(sn)
If Left(sn(j), 3) = "N" Then 'fout "3" moet "1" en "N" moet "L" zijn
c00 = Mid(sn(j), 10)
ElseIf InStr(sn(j), "_") Then
st = Split(Application.Trim(Replace(sn(j), "_", "")))
For jj = 0 To UBound(sp, 2)
sp(n, jj) = Choose(jj + 1, c00, Replace(st(0), ":", ""), st(1), c02, c01, st(UBound(st) - 1), --st(UBound(st)), st(1))
Next
n = n + 1
Else
c01 = Mid(sn(j), 15)
c02 = Val(c01)
c01 = Mid(c01, 8, InStr(c01, " ") - 8)
End If
Next

Sheet1.Cells(1).Resize(, 7) = Split("Lokatie Partij/Ch Nummer art.nr. Naam stuks kg")
Sheet1.Cells(2, 1).Resize(UBound(sp), UBound(sp, 2) + 1) = sp
Sheet1.Columns(7).NumberFormat = "0.000"
Sheet1.Columns(8).Font.Name = "IDAHC39M Code 39 Barcode"


End Sub


Ook fout door kladblok in Windows 11, maakte iedere keer bij openen een nieuw tabblad aan, opgelost door.

1701512399080.png

Tip van "SchoonePC" waarvoor dank!
 
Georgyboy, mag ik vragen waar je Kladblok voor gebruikt in dezen?
 
Tuurlijk! Het tekstbestand is hier op mijn PC in kladblok
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan