martedì 19 luglio 2016

Importa Metel cross reference - vbs

'

' carica il File Metel Cross Reference

'

Set OXl = createobject ("Excel.Application")

'

Set objArgs = WScript.Arguments 'Vedo se ci sono degli argomenti passati allo script

if objargs.count=0 then 'altrimenti mostro come si usa il programma

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

wscript.quit

end if

'

Filename=wscript.arguments(0)

'

dim archiviomacro

archiviomacro = "C:\macro-importazione-cross-reference.txt"

'

oXL.Visible = true

'oXL.workbooks.OpenText Filename,,,1,,,False,,True,,False,,,,"."

'''oXl.workbooks.add

set fichxl=oXL.workbooks.add

'

dim vir, ecomm

vir = chr(34)

ecomm = chr(38)

'

Set mdle = fichxl.VBProject.VBComponents.Add(1)

'

Dim fso, Text, testo, txtStream, conta

dim dacambiare

dacambiare = "#nomeFileDaImportare#"

conta = 3

'

Set fso = CreateObject("Scripting.FileSystemObject")

'

If fso.FileExists(archiviomacro) = true Then

Set txtStream = fso.OpenTextFile(archiviomacro) ' Apre file di testo.

Do While Not (txtStream.atEndOfStream)

Text = txtStream.ReadLine 'legge una riga

testo = replace(Text,dacambiare,Filename)

mdle.CodeModule.InsertLines conta, testo

conta = conta + 1

Loop

End If

'

oXL.Run "ImportaCrossReference"

'

wscript.quit

'*** End ***

'

'

'

' testo archiviomacro = "C:\macro-importazione-cross-reference.txt"

'

'

' macro importazione Metel cross reference.

'



Sub ImportaCrossReference()

'

'

'

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;#nomeFileDaImportare#", Destination:=Range("A1"))

.Name = "DATIIMPORTATI"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = xlWindows

.TextFileStartRow = 1

.TextFileParseType = xlFixedWidth

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = True

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2)

.TextFileFixedColumnWidths = Array(3, 16, 3, 16, 1, 30, 30)

.Refresh BackgroundQuery:=False

End With

'

' intestazione

Range("A1").Value = "Sigla Marchio"

Range("B1").Value = "Codice Prodotto"

Range("C1").Value = "Sigla Marchio"

Range("D1").Value = "Codice Prodotto"

Range("E1").Value = "Funzione"

Range("F1").Value = "Note"

Range("G1").Value = "Filler"

'

Range("h1").Value = "descrizione_Funzione"

Range("h2").Value = "0=ABBINAMENTO - 1=ALTERNATIVA"



'

Sheets(ActiveSheet.Name).Select

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

'

End Sub

'

'

'

Nessun commento:

Posta un commento