importazione listino metel

Attribute VB_Name = "importazione_listino_metel"

'

Option Explicit

'

' vba - procedura completa per importazione listino Metel

' inserisce intestazione campi/colonne

' dividi i prezzi per ottenere i due decimali

' inserisce in un foglio a parte la testata del listino

'

Sub ImportaListinoMetel()

'

' scelta file

Dim archivio

archivio = Application.GetOpenFilename("Tutti i file (*.*), *.*")

If archivio = False Then

Exit Sub

End If

'

Sheets.Add

Dim rigaletta, fso, f, sriga

' assegna il formato celle testo

Columns("A:D").Select

Selection.NumberFormat = "@"

Rows("2:2").Select

ActiveWindow.FreezePanes = True

sriga = 0

' legge il file di testo

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(archivio, 1, False)

Do While f.AtEndOfStream <> True

rigaletta = f.ReadLine

sriga = sriga + 1

ActiveSheet.Cells(sriga, 1) = rigaletta

Loop

f.Close

' analizza testo in colonne

ActiveSheet.Columns("A:A").Select

' tracciato record del listino metel

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _

FieldInfo:=Array(Array(0, 1), _

Array(3, 2), Array(19, 2), Array(32, 1), Array(75, 1), Array(80, 1), Array(85, 1), Array _

(90, 1), Array(96, 1), Array(97, 1), Array(108, 1), Array(119, 1), Array(125, 1), Array(128 _

, 1), Array(131, 1), Array(132, 1), Array(133, 5), Array(141, 2), Array(159, 2))

' divide i prezzi per inserire i due decimali

Dim quanterighe, contarighe, prezzogg, nprezzogg, prezzorr, nprezzorr, divisore, foglio

Set foglio = Sheets(ActiveSheet.Name)

divisore = 100 ' per i due decimali del prezzo grossista e al pubblico

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).row

'

For contarighe = 1 To quanterighe

prezzogg = ActiveSheet.Cells(contarighe, "J").Value ' prezzo grossista

prezzorr = ActiveSheet.Cells(contarighe, "K").Value ' prezzo al pubblico

If IsNull(prezzogg) = False And IsNumeric(prezzogg) = True Then

nprezzogg = prezzogg / divisore

ActiveSheet.Cells(contarighe, "J").Value = nprezzogg

End If

If IsNull(prezzorr) = False And IsNumeric(prezzorr) = True Then

nprezzorr = prezzorr / divisore

ActiveSheet.Cells(contarighe, "k").Value = nprezzorr

End If

Next

Sheets(ActiveSheet.Name).Name = "listino"

' inserisce i nomi dei campi

Call testatalistinometel("listino")

'

Columns("A:S").Select

Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("B2").Select

'

End Sub

'

Sub testatalistinometel(nomefoglio)

'

Sheets(nomefoglio).Cells(1, 1) = "Sigla Marchio"

Sheets(nomefoglio).Cells(1, 2) = "Codice Prodotto Produttore"

Sheets(nomefoglio).Cells(1, 3) = "Codice EAN"

Sheets(nomefoglio).Cells(1, 4) = "Descrizione prodotto"

Sheets(nomefoglio).Cells(1, 5) = "Quantità cartone"

Sheets(nomefoglio).Cells(1, 6) = "Quantità multipla ordinazione"

Sheets(nomefoglio).Cells(1, 7) = "Quantità minima ordinazione"

Sheets(nomefoglio).Cells(1, 8) = "Quantità massima ordinazione"

Sheets(nomefoglio).Cells(1, 9) = "Lead Time"

Sheets(nomefoglio).Cells(1, 10) = "Prezzo al grossista"

Sheets(nomefoglio).Cells(1, 11) = "Prezzo al Pubblico"

Sheets(nomefoglio).Cells(1, 12) = "Moltiplicatore prezzo"

Sheets(nomefoglio).Cells(1, 13) = "Codice Valuta"

Sheets(nomefoglio).Cells(1, 14) = "Unità di misura"

Sheets(nomefoglio).Cells(1, 15) = "Prodotto Composto"

Sheets(nomefoglio).Cells(1, 16) = "Stato del prodotto"

Sheets(nomefoglio).Cells(1, 17) = "Data ultima variazione"

Sheets(nomefoglio).Cells(1, 18) = "Famiglia di sconto"

Sheets(nomefoglio).Cells(1, 19) = "Famiglia statistica"

End Sub

'

Sub leggitesta(archivio)

Sheets.Add

Sheets(ActiveSheet.Name).Name = "testatalistino"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s, campo, conta

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFile(archivio)

Set ts = f.OpenAsTextStream(ForReading, TristateFalse)

s = ts.ReadLine

ts.Close

Dim posizioni, lunghezze, sriga

Dim posizione, lungo

posizioni = Array(1, 21, 24, 35, 41, 49, 57, 87, 126, 129)

lunghezze = Array(20, 3, 11, 6, 8, 8, 30, 39, 3, 49)

Dim nomicampi(10)

nomicampi(0) = "Identificazione tracciato"

nomicampi(1) = "sigla produttore"

nomicampi(2) = "Partita IVA"

nomicampi(3) = "Numero listino prezzi"

nomicampi(4) = "Decorrenza listino prezzi"

nomicampi(5) = "Data ultima variazione/immissione"

nomicampi(6) = "Descrizione listino prezzi"

nomicampi(7) = "spazio1"

nomicampi(8) = "Versione tracciato listino prezzi"

nomicampi(9) = "spazio2"

'

For conta = 0 To 9

posizione = posizioni(conta)

lungo = lunghezze(conta)

sriga = conta + 1

campo = "'" & Mid(s, posizione, lungo)

Sheets("testatalistino").Cells(sriga, 2) = nomicampi(conta)

Sheets("testatalistino").Cells(sriga, 3) = campo

Next conta

'

End Sub

'

Sub vedifoglio(nomefoglio)

On Error GoTo crea

Sheets(nomefoglio).Activate

Sheets(nomefoglio).Delete

crea:

Sheets.Add

Sheets(ActiveSheet.Name).Name = nomefoglio

'

End Sub

'

'

'