[Visual basic] codice per excel chi mi aiuta?

[~ZeRO sTrEsS~]

ciao ragazzi, mi servirebbe un piacere enorme, Devo creare un bottone in un file excel che quando premuto crea dei file di Testo in determinate con il contenuto di 4 fogli di un file excell, una specie di repot in file txt, sinceramente non mi importa la formattazione mi serve solo portare quello che c'é in questi 4 fogli in un file txt. ho trovato questo codice sul sito della microsoft per fare ció che voglio, ma funziona solo per un foglio...

http://support.microsoft.com/kb/635038/it

Sub file_testo()
Dim start As Range
Dim fine As Range

n = InputBox("INSERIRE IL NOME DEL FILE DI TESTO RISULTANTE")
n = n & ".txt"
Set start = Application.InputBox(prompt:="ANGOLO ALTO SINISTRO", Type:=8)
Set fine = Application.InputBox(prompt:="ANGOLO BASSO DESTRO", Type:=8)
colonna_inizio = Range(start.Address).Column
riga_inizio = Range(start.Address).Row
colonna_fine = Range(fine.Address).Column
riga_fine = Range(fine.Address).Row
Open n For Output As #1
For y = riga_inizio To riga_fine
For i = colonna_inizio To colonna_fine
valore = Cells(y, i).Value
If i = colonna_fine Then
valore = valore & Chr(13)
Else
valore = valore & ";"
End If
Print #1, valore;
Next i
Next y
Close #1
End Sub

Il separatore dei campi, puo` essere personalizzato con la seguente riga di
codice:

valore = valore & ";"

al posto del ";", si puo` inserire qualunque altro separatore.

Qualcuno mi saprebbe aiutare? Altra cosa che mi chiedevo é se era possibile implementare anche del codice che dovrebbe creare un file a parte con una piccola parte del primo foglio solo nel momento in cui la casella X é piena...

non so se mi sono spiegato caso mai non capite cerco di spiegarmi meglio!

Grazie a tutti in anticipo!

[uReverendo]

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ì:

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:

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]

Ho ricevuto il tuo pvt e ho fatto un po' di modifiche.

Sub SalvaComeTXT()
    Dim Interv As Range
    Dim strIntestazione As String
    Dim strFile As String
    Dim strFileParte As String
    
    ' Visualizza la finestra di dialogo "Salva" e recupera il nome del file
    strFile = DlgSalva
    
    If (strFile <> "") Then
        ' -------------------------------------------------------
        ' Stampa l'intervallo A1:D6 del Foglio1
        ' -------------------------------------------------------
        Set Interv = Worksheets("Foglio1").Range("A1:D6")
        strIntestazione = "[Foglio1]" & vbCrLf
        SalvaRange strFile, False, strIntestazione, Interv
        ' -------------------------------------------------------
        ' Stampa l'intervallo A1:F20 del Foglio2
        ' -------------------------------------------------------
        Set Interv = Worksheets("Foglio2").Range("A1:F20")
        strIntestazione = "[Foglio2]" & vbCrLf
        SalvaRange strFile, True, strIntestazione, Interv
        ' -------------------------------------------------------
        '
        '
        ' ... Continua per tutti i fogli che vuoi salvare ...
        '
        '
        ' Se la cella "A5" del Foglio1 ha del testo...
        If (Worksheets("Foglio1").Range("A5").Value <> "") Then
            ' ...salva parte del foglio nel file strFileParte
            
            ' Toglie l'estensione al nome del file
            strFileParte = Left(strFile, Len(strFile) - 4)
            ' Aggiunge un suffisso e rimette l'estensione
            strFileParte = strFileParte & "_parte.txt"
            
            ' Es. Se strFile = "c:\salvataggio.txt" allora
            ' strFileParte sarà uguale a "c:\salvataggio_parte.txt"
            
            Set Interv = Worksheets("Foglio1").Range("A1:B2")
            strIntestazione = "[Foglio1_parte]" & vbCrLf
            SalvaRange strFileParte, False, strIntestazione, Interv
            ' -------------------------------------------------------
        End If
    End If
    
End Sub

Private Function DlgSalva()
    Dim dlg As New CommonDialog
    Dim strFile As String
    
    ' Imposta le opzioni della finestra di dialogo
    dlg.DialogTitle = "Salva fogli come file di testo"
    dlg.Filter = "File di testo (*.txt)|*.txt"
    
    ' Visualizza la finestra di dialogo
    dlg.ShowSave
    
    ' Recupera il file selezionato
    strFile = dlg.Filename
    
    ' Se non si è premuto "annulla"...
    If (strFile <> "") Then
        ' ...restituisce il nome e il percorso del file
        DlgSalva = strFile
        Exit Function
    End If
    
    ' Se si è premuto "annulla" restituisce una stringa vuota
    DlgSalva = ""
End Function

Private Sub SalvaRange(ByVal strFile As String, ByVal blnAggiungi As Boolean, ByVal strIntestazione As String, ByRef Interv As Range)
    ' -------------------------------------------------------------------
    '  DESCRIZIONE: Salva su file un intervallo di celle.
    ' -------------------------------------------------------------------
    '  INPUT:
    ' -------------------------------------------------------------------
    '  strFile ->   Nome del file in cui salvare i dati.
    '               Se il file non esiste verrà creato.
    '               Se esiste verrà sovrascritto o i dati verranno
    '               aggiunti a seconda del valore di blnAggiungi.
    '
    '  blnAggiungi->Se TRUE: il dati verranno aggiunti al file
    '               Se FALSE: il file verrà sovrascritto
    '
    '  strIntestazione -> Intestazione da stampare nel file.
    '                     Se non si vuole intestazione passare ""
    '
    '  Interv    -> Intervallo da stampare
    ' -------------------------------------------------------------------
    
    Dim f As Integer
    Dim r As Integer
    Dim c As Integer
    
    On Error GoTo Errore
    
    ' Recupera un numero di file libero
    f = FreeFile
    
    If (blnAggiungi) Then
        ' Apre il file aggiungendo i dati alla fine
        Open strFile For Append As #f
    Else
        ' Se il file esiste...
        If (Dir(strFile) <> "") Then
            ' ...chiede conferma prima di sovrascriverlo
            Risp = MsgBox("Il file " & strFile & " già esiste lo vuoi sovrascrivere?", vbYesNo + vbQuestion, "Attenzione!")
            If (Risp = vbNo) Then
                ' Non si vuole sovrascrivere il file: ESCI!!!
                Exit Sub
            End If
        End If

        ' Apre il file sovrascriverlo
        Open strFile For Output As #f
    End If
    
    If (strIntestazione <> "") Then
        ' Scrive l'intestazione nel file
        Print #f, strIntestazione;
    End If
    
    ' Scrive il valore di ogni cella nel file
    For r = 1 To Interv.Rows.Count
        For c = 1 To Interv.Columns.Count
            valore = Interv.Cells(r, c).Value
            If c = Interv.Columns.Count Then
                valore = valore & vbCrLf
            Else
                valore = valore & ";"
            End If
            Print #f, valore;
        Next
    Next
    
    ' Chiude il file
    Close #f
    
    Exit Sub
    
' Gestisce eventuali errori
Errore:
    Dim strMsg As String
    strMsg = "Si è verificato un errore durante il salvataggio del file." & vbCrLf & "Errore Numero: " & Err.Number & vbCrLf & "Descrizione: " & Err.Description
    MsgBox strMsg, vbCritical
End Sub

Per farlo funzionare correttamente devi aggiungere un riferimento a "Microsoft Common Dialog Control 6.0" (da VBA: menu Strumenti\Riferimenti e seleziona la voce che ti ho detto. Se non la trovi, clicca su sfoglia e seleziona il file COMDLG32.OCX nella cartella system32)