View Single Post
Old 23-06-2007, 12:35   #2
uReverendo
Member
 
L'Avatar di uReverendo
 
Iscritto dal: May 2006
Messaggi: 69
Devi eseguire il codice da te postato per ogni foglio che vuoi salvare.
Ad esempio se vuoi salvare tutti i fogli di una cartella di lavoro in un unico file puoi fare così:
Codice:
Sub file_testo()
    Dim start As Range
    Dim fine As Range
    Dim Foglio  As Worksheet
    Dim strNomeDefault As String
    Dim strIntestazione As String
    Dim f As Integer
    
    'Imposta il nome di default del file
    strNomeDefault = "Prova"
    
    n = InputBox("INSERIRE IL NOME DEL FILE DI TESTO RISULTANTE", , strNomeDefault)
    n = n & ".txt"

    f = FreeFile
    Open n For Output As #f

    ' Per ogni foglio nella cartella di lavoro corrente...
    For Each Foglio In ActiveWorkbook.Worksheets
    
        ' Attiva il foglio
        Foglio.Activate
        
        Set start = Application.InputBox(prompt:="ANGOLO ALTO SINISTRO", Type:=8, Title:=Foglio.Name)
        Set fine = Application.InputBox(prompt:="ANGOLO BASSO DESTRO", Type:=8, Title:=Foglio.Name)
        colonna_inizio = Range(start.Address).Column
        riga_inizio = Range(start.Address).Row
        colonna_fine = Range(fine.Address).Column
        riga_fine = Range(fine.Address).Row
        
        ' Prepara l'intestazione
        ' (il nome del foglio corrente fra parentesi quadre + INVIO)
        strIntestazione = "[" & Foglio.Name & "]" & vbCrLf
        ' Scrive l'intestazione nel file
        Print #f, strIntestazione;
        
        For y = riga_inizio To riga_fine
            For i = colonna_inizio To colonna_fine
                valore = Foglio.Cells(y, i).Value
                If i = colonna_fine Then
                    valore = valore & vbCrLf
                Else
                    valore = valore & ";"
                End If
                Print #f, valore;
            Next i
        Next y
        
    Next
    
    Close #f
End Sub
Per quanto riguarda la seconda domanda puoi crearti una nuova funzione:
Codice:
Sub file_testo_parte()
    Dim Foglio As Worksheet
    Dim iRiga As Integer
    Dim iCol As Integer
    Dim strIntestazione As String
    Dim f As Integer
    
    ' Foglio contenente la cella da controllare
    Set Foglio = ActiveWorkbook.Worksheets("foglio1")
    
    ' Coordinate della cella da controllare
    iRiga = 5
    iCol = 3
    
    ' Se la cella non è vuota...
    If (Foglio.Cells(iRiga, iCol).Value <> "") Then
        ' ...salva parte del foglio
        
        'Imposta il nome del file
        n = "File_parte" & ".txt"
    
        ' Coordinate della cella inizio
        colonna_inizio = 1
        riga_inizio = 1
        ' Coordinate della cella fine
        colonna_fine = 3
        riga_fine = 3
        
        f = FreeFile
        Open n For Output As #f

        ' Prepara l'intestazione
        ' (il nome del foglio corrente fra parentesi quadre + INVIO)
        strIntestazione = "[" & Foglio.Name & " Parziale ]" & vbCrLf
        ' Scrive l'intestazione nel file
        Print #f, strIntestazione;
        
        For y = riga_inizio To riga_fine
            For i = colonna_inizio To colonna_fine
                valore = Foglio.Cells(y, i).Value
                If i = colonna_fine Then
                    valore = valore & vbCrLf
                Else
                    valore = valore & ";"
                End If
                Print #f, valore;
            Next i
        Next y
            
        Close #f
    End If
      
End Sub
Ovviamente il tutto può essere ottimizzato in base alle tue esigenze.
Se hai problemi chiedi pure.
uReverendo è offline