Buongiorno, ho una macro creata da una persona che ormai non lavora più con me, ho bisogno di capire se posso modificarla in questo senso: la macro mi prende un file job e mi restituisce dei dati, io vorrei che l'immissione dei file job sia multipla e non di solo uno.
Grazie
Codice:Sub Macro1() datifile = Application.GetOpenFilename("Files Job (*.job), *.job") 'col = Array("A", "D") par = Array("A", "B", "C", "D", "E", "F", "T", "H", "I", "J", "K", "L") 'Range("Riepilogo!A6:E596").ClearContents Range("Piani!A3:G596").ClearContents Range("Parti!A4:F596").ClearContents Range("Parti!H4:H596").ClearContents Range("Parti!T4:T596").ClearContents Range("Parti!V4:W596").ClearContents If datifile = False Then Exit Sub Open datifile For Input As #1 ActiveSheet.Unprotect Do While Not EOF(1) Line Input #1, rigadati '-+-+-+-+-+-+-+-+- Leggo dati -+-+-+-+-+-+-+-+- If Mid$(rigadati, 1, 13) = "[WORK:Commo" Then rg = 20 Do Line Input #1, rigadati pos = InStr(rigadati, "=") dat = Mid$(rigadati, pos + 1) Range("Riepilogo!D" & rg).Value = dat rg = rg + 1: grp = 0 If Mid$(rigadati, 1, 13) = "[WORK:Plans" Then Exit Do Loop While Not rigadati = "" End If If Mid$(rigadati, 1, 13) = "[WORK:Plans" Then rg = 3 Line Input #1, rigadati If Mid$(rigadati, 1, 13) <> "[WORK:Parts" Then pos = InStr(rigadati, "=") num = Mid$(rigadati, pos + 1) Range("Riepilogo!B13").Value = num For x = 1 To num For y = 1 To 12 Line Input #1, rigadati pos = InStr(rigadati, "=") dat = Mid$(rigadati, pos + 1) If y < 8 Then Range("Piani!" & par(y) & rg).Value = dat Else nodat = dat End If Next rg = rg + 1: grp = 0 Next End If End If If Mid$(rigadati, 1, 13) = "[WORK:Parts" Then rg = 4 Line Input #1, rigadati pos = InStr(rigadati, "=") num = Mid$(rigadati, pos + 1) For x = 1 To num For y = 1 To 8 Line Input #1, rigadati pos = InStr(rigadati, "=") dat = Mid$(rigadati, pos + 1) Range("Parti!" & par(y) & rg).Value = dat If y = 8 Then posx = InStr(dat, "x") lx = Val(Mid$(dat, 1, posx - 2)) ly = Val(Mid$(dat, posx + 2, 7)) Range("Parti!V" & rg).Value = lx Range("Parti!W" & rg).Value = ly End If Next For y = 1 To 3 Line Input #1, rigadati 'pos = InStr(rigadati, "=") 'dat = Mid$(rigadati, pos + 1) 'Range("Parti!" & par(y) & rg).Value = dat Next rg = rg + 1: grp = 0 Next End If Loop ActiveSheet.Protect Close End Sub
Yoghi87 il regolamento di questo forum, che avresti dovuto leggere all'atto dell'iscrizione, vieta (art. 3) il crossposting.
http://www.excelvba.it/Forum/thread.php?f=1&t=11116
La discussione viene chiusa.
Alfredo
"Non esistono cose facili o difficili; esistono cose che si sanno e cose che non si sanno"
"Solo due cose sono infinite: l'universo e la stupidità umana; riguardo l'universo ho ancora dei dubbi" (Albert Einstein)
Condividi nei tuoi social!