[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)