VBATools

Tworzenie tekstowych plików skryptowych

by on Sep.02, 2011, under Excel, Porady

Excel jest wyśmienitym nośnikiem danych. Można go między innymi wykorzystać do tworzenia/generowania plików skryptowych. Czyli plików o formacie TXT, które to będą uruchamiane jako “patche” lub importowane przez przez urządzenia sterujące.

Jednym z przykładów chciałem opisać poniżej.

Posiadamy w kolumnie “A” dane, które to potrzebujemy opakować w klamry:

“Start” + Nowa linia + “polecenie” + dane z komórki Excela + Nowa linia + “Stop”.

Option Explicit

Sub tworzenie_pliku_skryptowego()
'MVP Shon from VBATools.pl
Dim d&, x&, file$, F&: F = FreeFile
Dim okno, max_row&: max_row = Cells(Rows.Count, "a").End(xlUp).Row
Dim s$, lan$: lan = " łańcuch"
If max_row = 1 And Len(Trim(Cells(max_row, "a").Value)) = 0 Then
 MsgBox "Brak danych do exportu!", _
 vbExclamation, "Informacja o błędzie"
 Exit Sub
End If

Dim Wybor As FileDialog
Set Wybor = Application.FileDialog(msoFileDialogFolderPicker)
With Wybor
 .AllowMultiSelect = True
 .Title = "Wybierz katalog docelowy"
 .InitialFileName = ThisWorkbook.path
 .Show
 On Error GoTo blad
 file = .SelectedItems(1)
 On Error GoTo 0
End With
If file <> "" Then
Application.ScreenUpdating = False
If Len(file) = 0 Then Exit Sub
file = file & "Plik_ze_skryptem.txt"
Open file For Output As #F
 For d = 1 To max_row
 If Len(Trim(Cells(d, 1).Value)) > 0 Then
 x = x + 1
 Print #F, "START"                       '<- start
 Print #F, "text:" & Cells(d, 1).Value   '<- text +dane z komórki
 Print #F, "END"                         '<- koniec
 End If
 Next d
Close #1
Application.ScreenUpdating = True
Select Case x
 Case 1: s = "y"
 Case 2 To 4: lan = lan & "y": s = "e"
 Case Is > 4: lan = lan & "ów": s = "ych"
End Select
MsgBox "Wygenerowano " & x & lan & " skryptow" & s, _
 vbInformation, "Informacja dodatkowa VBATools.pl"
End If
blad:
End Sub

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.
:, , , ,

Leave a Reply