» »

rabib vba kodo za shranjevanje v bin (iz excella)

rabib vba kodo za shranjevanje v bin (iz excella)

Silikon ::

Pozdravljeni!
V excelu imam napisan en programček za avtomatsko obdelavo podatkov v bin datoteki.
Datoteka je velika 512 Bytov in na netu sem našel kodo za odpiranje/prenos podatkov v excell (Ta koda mi lepo zloži vsak byte (kot decimalno število) v svojo vrstico)

Private Sub CommandButton1_Click()
Dim intFileNum, bytTemp As Byte, intCellRow%
intFileNum = FreeFile
intCellRow = 0
FileName = Application.GetOpenFilename
If Not FileName = "False" Then MsgBox FileName
Open FileName For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
End Sub

Po končani obdelavi podatkov bi pa želel shranit rezultate oz spremembe v novo datoteko, oz...
bi rabil še kodo ki bi mi omogočila da obdelane podatke iz celic shranim nazaj v bin datoteko torej vseh 512 vrstic bi rad shranil nazaj v novo datoteko po zaporedju od 1 do 512 vrstice. (Torej da se ohrani enak format in velikost datoteke - 512 Bytov)
Please :)
P5B, INTEL E8400 3Ghz, 2GB RAM, VGA GTX260 CORE 216 - 896 RAM, 550W

amacar ::

Ko zaženem tvojo kodo za odpiranje .bin dobim pri branju na koncu še eno odvečno 0 zraven. Ne vem, če js anrobe zapišem .bin ali že tvoja koda deluje narobe pri branju.

V glavnem koda za shranjevanje (Pri dialogu za shranit ne pozabi na končnico .bin)
Sub shraniBin()

    Dim path As Variant
    Dim stevec As Integer
    Dim nFileNum As Integer
    
    path = Application.GetSaveAsFilename
    If path <> False Then
        nFileNum = FreeFile
        Open path For Binary Lock Read Write As #nFileNum
        stevec = 1
        While Cells(stevec, 1) <> ""
            Put #nFileNum, , CByte(Cells(stevec, 1))
            stevec = stevec + 1
        Wend
        Close #nFileNum
    End If
End Sub

Silikon ::

Amacar hvala! Dela skoraj perfektno, res je da moja prejšnja koda doda 513 vrstico z vrednostjo 0, ki je pri obdelavi sploh ne uporabljam, in ravno tale 513 mi sedaj dela težavo pri shranjevanju namreč dobim 513 Bytov. Lahko mogoče prilagodiš tvojo kodo da naj shrani samo prvih 512 vrstic? Lp
P5B, INTEL E8400 3Ghz, 2GB RAM, VGA GTX260 CORE 216 - 896 RAM, 550W

amacar ::

Sub shraniBin()

    Dim path As Variant
    Dim stevec As Integer
    Dim nFileNum As Integer
    
    path = Application.GetSaveAsFilename
    If path <> False Then
        nFileNum = FreeFile
        Open path For Binary Lock Read Write As #nFileNum
        stevec = 1
        While stevec < 513
            Put #nFileNum, , CByte(Cells(stevec, 1))
            stevec = stevec + 1
        Wend
        Close #nFileNum
    End If
End Sub

Silikon ::

Hvala!
Dela super sedaj!
Lp!
P5B, INTEL E8400 3Ghz, 2GB RAM, VGA GTX260 CORE 216 - 896 RAM, 550W

Silikon ::

Hoj!
Rabim še eno nadgradnjo algoritma :) Če je možno :)
Ali se lahko integrira v kodo za odpiranje datoteke sprogramira, da se recimo bin datoteka naloži v stolepc A na del. listu 2
Tvoja koda za shranjevanje pa naj se izvede na celicah stolpca A na delovnem listu 3?

Namreč podatke obdelujem na delovnem zvezku 1, podatke pa bi rad imel ločeno (load / save) datoteke bi rad izvajal na del zvezku 1.
Če to zrihtaš si pa res CAR :)
P5B, INTEL E8400 3Ghz, 2GB RAM, VGA GTX260 CORE 216 - 896 RAM, 550W

amacar ::

Za pravo vsoto se da vse zmenit :D

Sub naloziBin()
Dim intFileNum, bytTemp As Byte, intCellRow%
intFileNum = FreeFile
intCellRow = 0
Filename = Application.GetOpenFilename
If Not Filename = "False" Then MsgBox Filename
Open Filename For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Sheets(2).Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
End Sub


Sub shraniBin()
    Dim path As Variant
    Dim stevec As Integer
    Dim nFileNum As Integer
     
    path = Application.GetSaveAsFilename
    If path <> False Then
        nFileNum = FreeFile
        Open path For Binary Lock Read Write As #nFileNum
        stevec = 1
        While stevec < 513
            Put #nFileNum, , CByte(Sheets(3).Cells(stevec, 1))
            stevec = stevec + 1
        Wend
        Close #nFileNum
    End If
End Sub

Silikon ::

;)

Lej ko se naslednjič vidima skupaj ti bo vse jasno, če ne prej se vidimo za krst maelga Li... :) :) :) :)
P5B, INTEL E8400 3Ghz, 2GB RAM, VGA GTX260 CORE 216 - 896 RAM, 550W



Vredno ogleda ...

TemaSporočilaOglediZadnje sporočilo
TemaSporočilaOglediZadnje sporočilo
»

Uvoz txt datoteke v excel

Oddelek: Programska oprema
294619 (4256) sebavet
»

vb.net: dynamic textbox

Oddelek: Programiranje
51085 (975) saule
»

Calc/excel delo s tabelo

Oddelek: Programiranje
131324 (1091) salabajs
»

[VB] graf, merilnik hitrosti, termometer

Oddelek: Programiranje
52201 (2066) darkolord
»

Visual Basic in Excel

Oddelek: Programiranje
262482 (2048) Vesoljc

Več podobnih tem