Problema macro

[yoghi87]

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

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

[alfrimpa]

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.