- Milyen billentyűzetet vegyek?
- Milyen monitort vegyek?
- A SAMA jóvoltából konkurenciája jött a Thermalright léghűtéseinek?
- OLED monitor topic
- Azonnali fotós kérdések órája
- Vezetékes FEJhallgatók
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Kormányok / autós szimulátorok topikja
- Multimédiás / PC-s hangfalszettek (2.0, 2.1, 5.1)
- NVIDIA GeForce RTX 4080 /4080S / 4090 (AD103 / 102)
Hirdetés
Új hozzászólás Aktív témák
-
vilag
tag
Kis javítás a kódokban:
1. verzió:
Public szov As String
Public h As Long
Private Sub CommandButton1_Click()
vkod = ""
ossz = 0
szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
ActiveSheet.Cells(3, 3) = szov
If szov = "" Then GoTo vege
h = Len(szov)
If h > 100 Then GoTo vege
Dim vk(2, 100)
For i = 0 To h
If i = 0 Then
vk(1, i) = Chr(204)
vk(2, i) = 104
Else
vk(1, i) = Mid(szov, i, 1)
vk(2, i) = Asc(vk(1, i)) - 32
End If
If i = 0 Then k = 1 Else k = i
ossz = ossz + vk(2, i) * k
vkod = vkod + vk(1, i)
Next
eossz = ossz Mod 103
ActiveSheet.Cells(2, 2) = eossz
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If
ActiveSheet.Cells(2, 3) = vkod
vege:
vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")
End SubValamiért nem csinálja meg a kiemelést.
Ez a javítás:
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If2. verzió:
Public szov As String
Public h As LongPrivate Sub CommandButton1_Click()
vkod = ""
ossz = 0
szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
ActiveSheet.Cells(3, 3) = szov
If szov = "" Then GoTo vege
h = Len(szov)
If h > 100 Then GoTo vege
j = 1Dim vk(2, 100)
For i = 0 To h
Select Case i
Case 0
vk(1, i) = Chr(204)
vk(2, i) = 104
j = i
Case 1 To 2
vk(1, i) = Mid(szov, i, 1)
If Asc(vk(1, i)) < 195 Then vk(2, i) = Asc(vk(1, i)) - 32 Else vk(2, i) = Asc(vk(1, i)) - 100
j = i
Case 3
j = i
vk(1, i) = Chr(199)
vk(2, i) = Asc(vk(1, i)) - 100
Case Else
' If Application.WorksheetFunction.IsEven(i) = True Then 'XP alatt nem működik!!!
If i Mod 2 = 0 Then 'XP alatt is működik
j = i - ((i - 4) / 2)
s2 = Val(Mid(szov, i - 1, 2))
If s2 < 95 Then vk(1, j) = Chr(s2 + 32) Else vk(1, j) = Chr(s2 + 100)
vk(2, j) = s2
End IfEnd Select
If j = 0 Then k = 1 Else k = j
' If i <= 3 Or Application.WorksheetFunction.IsEven(i) = True Then 'XP alatt nem működik
If i Mod 2 = 0 Then 'XP alatt is működik
ossz = ossz + vk(2, j) * k
vkod = vkod + vk(1, j)
End If
Nexteossz = ossz Mod 103
ActiveSheet.Cells(2, 2) = eossz
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If
ActiveSheet.Cells(2, 3) = vkod
vege:
vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")End Sub
Remélem még hasznos lehet valakinek.
Új hozzászólás Aktív témák
- Lenovo T480 i7- 8650u / HU bill! / 8Gb DDR4 / 256Gb Nvme SSD / IPS full HD/ újszerű állapot / Win11
- Dell Latitude 5590 / i5 8350u / IPS FHD 15,6" / 8GB DDR4 / 256Gb SSD / Win11
- Micron 1100 256GB 2,5" SSD-k
- DJI Avata 2 Fly More Combo (szinte új, 3 év garival)
- Új,bontatlan,dobozos, számlás,garanciás 7800X3D CPu.
- Samsung Galaxy S24 Ultra / 12RAM 1024GB / Gyárifüggetlen / 12hó Garanciával
- Gamer PC- Számítógép! Csere-Beszámítás! I3 10100F / RTX 2060 / 32GB DDR4 / 500GB SSD
- Apple iPhone 8 64GB, Kártyafüggetlen, 1 Év Garanciával
- Dell Precision 5540 i7-9850H 16GB 512GB Nvidia Quadro T1000 15.6" FHD 1 év garancia
- Vállalom Xiaomi Okoskamerák szoftveres javíttását
Állásajánlatok
Cég: FOTC
Város: Budapest