mercoledì 10 luglio 2013

VBA creare un file di testo da un file Excel

Pubblico con grande piacere il frammento di codice qui di seguito di un mio affezionato lettore.
Marco, ha scritto una procedura in VBA da utilizzare in Excel, che permette di leggere le varie celle e generare un file di testo con il valore relativo al contenuto delle celle.

Complimenti a Marco per questa segnalazione.


Private Sub CreaFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CreaFile.Click

        'Cerco e apro il file excel
        Dim OpenFileDialog1 As New OpenFileDialog
        Dim qWB As Excel.Workbook = Nothing
        Dim qWS As Excel.Worksheet = Nothing
        Dim CELLA As Object

        Try

            OpenFileDialog1.Title = "Seleziona il file degli esiti desiderato"
            OpenFileDialog1.InitialDirectory = "C:\Documents and Settings\porzio\Desktop\Cartella\Esiti\"
            OpenFileDialog1.Filter = "Excel files (*.xls)|*.xls"

            If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
                qXL = New Excel.Application
                qXL.DisplayAlerts = False
                qWBS = qXL.Workbooks
                qWB = qWBS.Open(OpenFileDialog1.FileName)
                TextBox1.Text = (OpenFileDialog1.FileName)
                qXL.Visible = True
                qWS = CType(qWB.ActiveSheet, Excel.Worksheet)
                qR = qWB.Worksheets(1)
                qR.Range("A16").Select()
                CELLA = qR.Range("A16")
            Else
                Exit Sub
            End If

            'Ora leggo le informazioni del file e genero un file di testo per ogni riga
            Dim CONTA_FILE As Integer = 1

            Do Until CELLA.VALUE = ""

                Using sw As StreamWriter = New StreamWriter("Percorso\Nome file n° " & CONTA_FILE & ".txt")

                    sw.WriteLine("Titolo")
                    sw.WriteLine("")
                    sw.WriteLine("Informazioni aggiuntive")
                  'Qui leggo il dato della cella che mi serve (in questo caso colonna I)
                    sw.WriteLine("*1;;;;;;;;;;;;;;;;;;" & Replace(CELLA.OFFSET(0, 8).VALUE, ",", "."))
                    sw.Close()
                End Using
                CELLA = CELLA.OFFSET(1, 0)
                CONTA_FILE = CONTA_FILE + 1
            Loop

            qWB.Close()
            qXL.Quit()
            qWB = Nothing
            qXL = Nothing

            MessageBox.Show("Fine", "Esecuzione comando", MessageBoxButtons.OK, MessageBoxIcon.Information)

        Catch ex As Exception

            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End Try

    End Sub

Nessun commento: