Crea catalogo jpg to pdf

Attribute VB_Name = "m_crea_catalogo_jpg_to_pdf"

'

'

Option Explicit

'

' vba - crea file Pdf da un elenco di immagini jpg.

' utilizza la classe: "mjwPDF"

'

' riferimenti classe:

' Creating PDF files in Visual Basic

' "mjwPDF 1.0"

' classe scaricabile dal sito:

' http://www.vb6.us/tutorials/visual-basic-tutorial-pdf

'

Sub CatalogoImmaginiPdf()

'

Dim immagine

Dim foglio, quanterighe, conta, quantejpg, contajpg, filejpg As String, titolodocumento

Dim percorsodocumentodacreare, percorsopdffonts, percorsojpg, txtlink

Set foglio = Sheets("db")

quanterighe = foglio.UsedRange.Rows.Count

quantejpg = 10

'

titolodocumento = "documento di prova pdf"

txtlink = "http:// il vostro sito da dichiare"

percorsodocumentodacreare = "C:\catalogo-jpg.pdf"

percorsopdffonts = "C:\pdfFonts"

percorsojpg = "c:\jpg\"

' Create a simple PDF file using the mjwPDF class

Dim objPDF As New mjwPDF



' Set the PDF title and filename

objPDF.PDFTitle = titolodocumento

objPDF.PDFFileName = percorsodocumentodacreare



' We must tell the class where the PDF fonts are located

objPDF.PDFLoadAfm = percorsopdffonts



' Set the file properties

objPDF.PDFSetLayoutMode = LAYOUT_DEFAULT

objPDF.PDFFormatPage = FORMAT_A4

objPDF.PDFOrientation = ORIENT_PORTRAIT

objPDF.PDFSetUnit = UNIT_PT



' Lets us set see the bookmark pane when we view the PDF

objPDF.PDFUseOutlines = True

'

' Begin our PDF document

objPDF.PDFBeginDoc

' Lets add a heading

objPDF.PDFSetFont FONT_ARIAL, 12, FONT_BOLD

objPDF.PDFSetDrawColor = vbRed

objPDF.PDFSetTextColor = vbBlack

'objPDF.PDFSetAlignement = ALIGN_Right

objPDF.PDFSetAlignement = ALIGN_Left

objPDF.PDFSetBorder = BORDER_None

'objPDF.PDFSetFill = True

''''

Dim jpgdasinistra As Double, jpgdallalto As Double, jpgaltezza As Double, jpglunghezza As Double

jpgdasinistra = 20

jpgdallalto = 15

jpgaltezza = 50

jpglunghezza = 50

'

contajpg = 0

For conta = 2 To quanterighe

immagine = foglio.Cells(conta, 2)

filejpg = percorsojpg & immagine

'

If Len(immagine) = 0 Then

immagine = "nd.jpg"

End If

'

'Lets add an image to page

objPDF.PDFImage filejpg, jpgdasinistra, jpgdallalto, jpglunghezza, jpgaltezza, CStr(txtlink)

jpgdallalto = jpgdallalto + jpgaltezza + 10

'

contajpg = contajpg + 1

If contajpg > quantejpg Then

contajpg = 0

jpgdallalto = 15

objPDF.PDFEndPage

'Start page

objPDF.PDFNewPage

End If

Next conta

'

' End our PDF document (this will save it to the filename)

objPDF.PDFEndDoc

'

MsgBox "catalogo creato in: " & percorsodocumentodacreare

'

End Sub

dividi articoli - vbs

' *****

' esempio file di origine:

'AAA418|PLAFON. CABL 4X18 W|NR|22|0|0|0|0|00|0|0|160|11/05/2011|1446|AAA|AAA|0000000000000

'BBB00050|SCATOLA CONICA D.65|NR|22|0|0|0|0|0|0|0|204|16/09/2013|00050|BBB|BBB|0000000000000

'************************************************

' vbs - divide un file di testo in più file.

' utilizza i primi tre caratteri di ogni riga per determinare il nome del file di output

'************************************************

option explicit

'

' ForAppending = 8 ForReading = 1, ForWriting = 2

Const ForAppending = 8

'

Dim fso, farticoli, datiletti, iniziali, contenuti

dim marchivio, s, archiviodef, archivioorigine, archiviolog, archivioelenco, cartelladiscrittura, log, elencof

' ==== path dei file utilizzati

' === archivio di default per le iniziali non dichiarate

archiviodef = "C:\listino-personalizzato\articolialtri.txt"

' === file contenente gli articoli da suddividere

archivioorigine = "C:\listino-personalizzato\articoli.txt"

' file di log - copia del file di origine

archiviolog = "C:\listino-personalizzato\log.txt"

' elenco dei file creati

archivioelenco = "C:\listino-personalizzato\da-bus\elencofile.txt"

'

cartelladiscrittura = "C:\listino-personalizzato\"

' ====

'

Set fso = CreateObject("Scripting.FileSystemObject")

'file contenente gli articoli da suddividere

Set farticoli = fso.OpenTextFile(archivioorigine) ' Apre file di testo.

' file di log - copia del file di origine

Set log = fso.OpenTextFile(archiviolog, 2, True)

' elenco dei file creati

Set elencof = fso.OpenTextFile(archivioelenco, 2, True)

'

Do While Not (farticoli.atEndOfStream)

datiletti = farticoli.ReadLine 'legge una riga

if len(datiletti) => 3 then

iniziali = left(datiletti,3)

log.writeline(datiletti)

call scrivifile(iniziali,datiletti)

else

log.writeline(datiletti)

call scrivifile("articolivari",datiletti)

end if

Loop

'

sub scrivifile(piniziali,pdatiletti)

dim afso, archivio, fscrivo, presente

Set afso = CreateObject("Scripting.FileSystemObject")

'

archivio = cartelladiscrittura & piniziali & ".txt"

presente = instr(piniziali,"|")

if presente > 0 then

archivio = archiviodef

end if

'

marchivio = archivio

Select Case piniziali

' per queste iniziali viene creato un file specifico

Case "ABB", "ARC", "ARE", "ALL"

CASE "BER", "BOC", "TIC", "L&L"

CASE "CAM", "COM", "AIR", "GUZ"

CASE "CEM", "COE", "CAV", "MRT"

CASE "SUR", "GEW", "MTT", "TIC", "NMZ"

CASE "PLE", "VIW", "PRI", "TAR", "PAL"

CASE "TRE", "NOX", "ETN", "SIL", "VIM"

CASE "LEO", "TEN", "FRA", "SIM", "MAR"

CASE "OMR", "ELV", "FAI", "LOM", "URM"

CASE "PRO", "OTY", "SID", "IVE", "LUM"

CASE "EGO", "LPU", "VIP", "TUT", "VAL"

CASE "PRA", "LT3", "CST", "MCI", "IDL", "NAT"

CASE "LUC", "FOS", "ZUC", "VOR", "OSR", "GMB"

CASE "OVA", "PHI", "MEG", "INT", "REG", "SIS"

'

Case Else

archivio = archiviodef

End Select

'

If afso.FileExists(archivio) = true Then

Set fscrivo = afso.OpenTextFile(archivio, ForAppending, True) ' Apre file di testo.

else

Set fscrivo = afso.OpenTextFile(archivio, 2, True)

fscrivo.WriteLine("SG|TX|AR_UNMIS|AR_CODIVA|PREZZO1|PREZZO2|listino|prezzo|sconto1|sconto2|sconto3|L_AV_CLASS|aggiornato|ar_codalt|siglacaem|siglametel|ean13")

'

s = " File """ & archivio & """"

elencof.WriteLine(s)

end if

'

fscrivo.WriteLine(pdatiletti)

fscrivo.Close

'

set afso = nothing

end sub

'

'

' ===

sconponi split pdf - vbs

'

' drag e drop

'

' estre e crea un file pdf per ogni pagina di un documento.

' utilizza Pdf Split and Merge

' scaricabile da: http://sourceforge.net/projects/pdfsam/

'

Option Explicit

'

dim objArgs, I

'

Set objArgs = WScript.Arguments 'Verifica esistenza presenza argomenti passati allo script

if objargs.count=0 then ' conteggio elementi

msgbox "Trascinare un file sul programma per visualizzarlo", vbinformation+vbokonly, Title

wscript.quit

end if

'

dim archivio, objFile, esegui, programma, attesa

Dim strTmp, objShell

'

set objShell = WScript.CreateObject("Wscript.Shell")

'

For I = 0 to objArgs.Count - 1

archivio = objArgs(I)

strTmp = "java -jar C:\Programmi\pdfsam\lib\pdfsam-console-0.5.2.jar -f " & archivio & " -p pdfsam_ -s BURST -o C:\provep\s2 split"

attesa = objShell.Run (strTmp, 1, True)

Next

'

Set objShell = Nothing '

' *****

Ghostscript pdf to jpg - vbs

'

' vbs - Ghostscript pdf to jpg

' converte tutti i file in formato pdf in immagini jpg.

' collocare il programmino nella directory interessata e cliccateci sopra.

' utilizza per la conversione Ghostscript.

' la risoluzione immagige è 600 px: azione = azione & " -r600 "

Option explicit

'

Dim file ' il file da convertire

Dim folder ' la directory corrente

Dim fso ' file system object

dim percorso, azione

dim archivio, archiviojpg, archiviopdf

dim tipo

dim esegui

Set Esegui = CreateObject("WScript.Shell")

'

' Creo il FileSystemObject

Set fso=CreateObject("Scripting.FileSystemObject")

'

' recupero la directory corrente

Set folder=fso.GetFolder(".")

'

' scorro tutti i file corrispondenti

For Each file in folder.Files

' msgbox file.Name

archivio = file.Name

if Len(archivio) > 5 then

tipo = Right(LCase(archivio),4)

if tipo = ".pdf" or tipo = ".PDF" then

percorso = folder & "\" & file.name

archiviopdf = file.name

' msgbox archiviopdf

archiviojpg = LEFT(archiviopdf,LEN(ARCHIVIOPDF)-3)

archiviojpg = archiviojpg & "jpg" ' 32

azione = ""

' path dipendente dalla versione di Ghoscript installata

' azione = azione & ""C:\Program Files (x86)\gs\gs9.07\bin\gswin32"" -dNOPAUSE -sDEVICE=jpeg "

azione = azione & "C:\Programmi\gs\gs8.64\bin\gswin32 -dNOPAUSE -sDEVICE=jpeg "

azione = azione & " -r600 "

azione = azione & " -sOutputFile=" & archiviojpg

azione = azione & " -dBATCH " & archiviopdf

'

Esegui.Run azione, 2, true

'

end if

end if

'

Next

'

'

'msgbox "finito"

'

'*********************************************************

legge un file listino Metel ed estrae in un file di testo solo articoli inseriti bel file trova

'

' vbs - legge un file Metel ed estrae, in un file di testo, solo

' gli articoli inseriti nel file trova.txt

' esempio struttura file trova.txt:

' 4878

' 4881

' 54776

' 50264

'

option explicit

'

Const ForReading = 1 'Apre un file in lettura.

dim filelistinometel, filerisultato, filericercati, dovescrivere, messaggio

Dim fso, ftrovati, fleggi, articolodatrovare, memorizzati(), contali, quanti, conta

Set fso = CreateObject("Scripting.FileSystemObject")

' === nome dei file da utilzzare

filelistinometel = "C:\LISTINOLSP.TXT" ' file listino metel

filericercati = "C:\trova.txt" ' file contenenti articoli da trovare

filerisultato = "C:\ttrovati.txt" ' file articoli corrispondenti

'

messaggio = ""

messaggio = messaggio & time & vbcrlf

'

'

Set dovescrivere = fso.CreateTextFile(filerisultato)

Set fleggi = fso.OpenTextFile(filericercati, ForReading, False)

'

' === carica in memoria il listino metel

quanti = 0

call Caricafile(filelistinometel)

'

' === per recuperare la testata del listino

call ricercadatato("METEL")

'

' === legge in memoria tutto il file

Do While fleggi.AtEndOfStream <> True

articolodatrovare = fleggi.ReadLine

call ricercadatato(articolodatrovare)

Loop

'

'

dovescrivere.close

fleggi.close

'

messaggio = messaggio & time & vbcrlf & "nr. articoli: " & quanti

msgbox messaggio

' ===

sub ricercadatato(articoloricercato)

Dim articolo, strdata, lunghezzaarticolo

lunghezzaarticolo = 19

for conta = 1 to quanti

strdata = memorizzati(conta)

articolo = left(strdata,lunghezzaarticolo)

if instr(articolo, articoloricercato) then

dovescrivere.WriteLine strdata

End If

next

'

end sub

' === memorizza in una array tutti gli articoli

Sub Caricafile(sFileName)

Dim fp, rigaletta

Set fp = fso.OpenTextFile( sFileName, ForReading, False)

Do While fp.AtEndOfStream <> True

rigaletta = fp.ReadLine

quanti = quanti + 1

redim preserve memorizzati(quanti)

memorizzati(quanti) = rigaletta

Loop

fp.Close

End Sub

'

'

vbs suddividi file - vbs

'

' vbs - suddivide un file Metel di grandi dimensioni

' in file da 60.000 righe

'

option explicit

'

dim filelistinometel

filelistinometel = "C:\LISTINOLSP.TXT"

'

Const ForReading = 1 'Apre un file in lettura.

Dim fso, fileinlettura, rigaletta, contarighe, testata, fileinscrittura, contafile

Set fso = CreateObject("Scripting.FileSystemObject")

Set fileinlettura = fso.OpenTextFile(filelistinometel, ForReading, False)

'

contarighe = 0

contafile = 0

Do While fileinlettura.AtEndOfStream <> True

rigaletta = fileinlettura.ReadLine

contarighe = contarighe + 1

if contarighe = 1 then

testata = rigaletta

contafile = contafile + 1

call creafiledascrivere(testata)

else

fileinscrittura.WriteLine rigaletta

end if

if contarighe > 60000 then

fileinscrittura.Close

contafile = contafile + 1

contarighe = 2

call creafiledascrivere(testata)

end if

Loop

fileinlettura.Close

fileinscrittura.Close

'

sub creafiledascrivere(contenuto)

dim nomefilescrittura

nomefilescrittura = "C:\list-" & contafile & ".txt"

Set fileinscrittura = fso.CreateTextFile(nomefilescrittura)

fileinscrittura.WriteLine contenuto

end sub

'

' ===

m ricostruzione articolo

Attribute VB_Name = "m_ricostruzione_articolo"

'

Option Explicit

'

'

Dim restituito

'

' vba === ricostruzione articolo originario

' per abbinamento

' articolo cliente: EA0115

' articolo fornitore: EA 011 5

'

Sub ScansionaArticoli()

Dim quanterighe, contarighe, foglio, colonnadaleggere, contenuto

Set foglio = Sheets(ActiveSheet.Name)

'

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

contarighe = 2

colonnadaleggere = "k"

'

While contarighe < quanterighe

contenuto = Trim(foglio.Cells(contarighe, colonnadaleggere).Value)

If Len(contenuto) = 6 Then

Call aritcoloanalizza(contenuto, "(\S)", 6)

foglio.Cells(contarighe, colonnadaleggere).Value = restituito

End If

contarighe = contarighe + 1

Wend

'

'

End Sub

'

Sub aritcoloanalizza(contenuto, cosatrovare, lunghezzarichiesta)

Dim oggRegEx, myMatches, myMatch

Set oggRegEx = CreateObject("VBScript.RegExp")

'

oggRegEx.Global = True

oggRegEx.Pattern = cosatrovare

Set myMatches = oggRegEx.Execute(contenuto)

'

If myMatches.Count = lunghezzarichiesta Then

restituito = ""

restituito = restituito & myMatches(0).Value

restituito = restituito & myMatches(1).Value

restituito = restituito & " "

restituito = restituito & myMatches(2).Value

restituito = restituito & myMatches(3).Value

restituito = restituito & myMatches(4).Value

restituito = restituito & " "

restituito = restituito & myMatches(5).Value

End If

'

'

End Sub