Risultati da 1 a 2 di 2

Discussione: Problema macro



  1. #1
    L'avatar di yoghi87
    Clicca e Apri
    Data Registrazione
    Oct 2016
    Località
    PIOBBICO
    Età
    29
    Messaggi
    2
    Versione Office
    2010
    Utile ricevuti
    0
    Utile dati
    0

    Problema macro

    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
    Invia MPPM 

  2. #2
    L'avatar di alfrimpa
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Napoli
    Età
    63
    Messaggi
    3278
    Versione Office
    2007 - 2013
    Utile ricevuti
    435
    Utile dati
    69

    Re: Problema macro

    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)
    Invia MPPM 

Discussioni Simili

  1. [Risolto] Problema macro su alti PC
    Di homer75 nel forum Domande su Excel VBA e MACRO
    Risposte: 12
    Ultimo Messaggio: 22/12/16, 15:19
  2. Problema di macro
    Di Attilio nel forum Domande su Excel VBA e MACRO
    Risposte: 18
    Ultimo Messaggio: 21/12/16, 14:04
  3. Problema con una Macro
    Di svizzera nel forum Domande su Excel VBA e MACRO
    Risposte: 8
    Ultimo Messaggio: 11/11/16, 11:39
  4. Problema su macro
    Di bobparr nel forum Domande su Microsoft Access
    Risposte: 5
    Ultimo Messaggio: 31/05/16, 15:39
  5. Problema Macro excel
    Di Ippo89 nel forum Domande su Excel VBA e MACRO
    Risposte: 7
    Ultimo Messaggio: 24/02/16, 12:49

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •