export données vers fichiers texte

Re : export données vers fichiers texte

Bonjour,

Dans la mesure où j'ai bien compris votre problème, voici une solution avec le code suivant.
Je me suis référé entièrement à votre fichier exemple. Par conséquent, les données doivent
IMPERATIVEMENT commencées en "A3".

Les fichiers .FNC sont créés dans un sous-dossier du dossier "Dossier FNC" qui est dans le
même répertoire que le classeur Excel actif. Le nom du sous-dossier sera du type
20-12-2008 123221
où 20-12-2008 est la date de création et où 123221 exprime l'heure
soit 12 heures 32 minutes 21 secondes. Tout cela, pour éviter les conflits sur
les dossiers déjà existant.

Faites un test sur une COPIE de votre classeur.

Le code à recopier dans un module standard.
*************************
Const DEPART As Long = 3 'ligne de départ
Const INCR As Long = 10 'incrément des lignes

Const ENTETE As String = _
"*" & vbCrLf & "* Description :" & vbCrLf & "*" & vbCrLf
Const CORPS As String = _
vbCrLf & "*" & vbCrLf & "* Associated Sound Files :" & vbCrLf & "*" _
& vbCrLf & "*" & vbCrLf & "* TextColor and Icon :" _
& vbCrLf & "*" & vbCrLf & "4000 1 (Rien)" _
& vbCrLf & "*" & vbCrLf & "* Function Actions :" _
& vbCrLf & "*" & vbCrLf

Type structFnc
FileName As String
N1003 As String
Code As String
End Type
Type structCM
MasqCM As structFnc
DeMasqCM As structFnc
ResetCM As structFnc
End Type

Sub Export2fnc()
Dim S As Worksheet
Dim R As Range
Dim var
Dim Col&
Dim Lig&
Dim CM() As structCM
Dim i&
Dim cpt&
On Error GoTo Erreur
Set S = ActiveSheet
Col& = S.UsedRange.Columns.Count
Lig& = Range("a65536").End(xlUp).Row
Set R = S.Range(S.Cells(1, 1), S.Cells(Lig&, Col&))
var = R
For i& = DEPART To Lig& Step INCR
cpt& = cpt& + 1
ReDim Preserve CM(1 To cpt&)
With CM(cpt&)
With .MasqCM
.FileName = S.Range("ac" & i& + 4 & "") & ".fnc"
.N1003 = "1003 Masquage " & S.Range("a" & i& & "")
.Code = "101 161.110.1.141 1 1 " & _
S.Range("ac" & i& + 1 & "") & " 1 0 0 0 0 0"
End With
With .DeMasqCM
.FileName = S.Range("ab" & i& + 4 & "") & ".fnc"
.N1003 = "1003 Démasquage " & S.Range("a" & i& & "")
.Code = "101 161.110.1.141 1 1 " & _
S.Range("ab" & i& + 1 & "") & " 0 0 0 0 0 0"
End With
With .ResetCM
.FileName = S.Range("ad" & i& + 4 & "") & ".fnc"
.N1003 = "1003 Reset " & S.Range("a" & i& & "")
.Code = "3 " & _
S.Range("ad" & i& + 5 & "") & " 0 0 0 0 0 0 0 0 0"
End With
End With
Next i&
'--------------
Dim fso As Object 'FileSystemObject
Dim Dossier As Object 'Folder
Dim Fichier As Object 'TextStream
Dim Chemin$
Dim Nom$
Dim A$
Dim B$
Chemin$ = ActiveWorkbook.Path & "\Dossier FNC"
Nom$ = Replace(Now, "/", "-")
Nom$ = Replace(Nom$, ":", "")
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
If .FolderExists(Chemin$) Then
Set Dossier = .GetFolder(Chemin$)
Else
Set Dossier = .CreateFolder(Chemin$)
End If
Chemin$ = Chemin$ & "\" & Nom$
Set Dossier = .CreateFolder(Chemin$)
End With
For i& = 1 To UBound(CM)
With CM(i&).MasqCM
B$ = Chemin$ & "\" & .FileName
A$ = ENTETE & .N1003 & CORPS & .Code
GoSub MakeFileFNC
End With
With CM(i&).DeMasqCM
B$ = Chemin$ & "\" & .FileName
A$ = ENTETE & .N1003 & CORPS & .Code
GoSub MakeFileFNC
End With
With CM(i&).ResetCM
B$ = Chemin$ & "\" & .FileName
A$ = ENTETE & .N1003 & CORPS & .Code
GoSub MakeFileFNC
End With
Next i&
MsgBox prompt:="Les fichiers .fnc sont dans le dossier " & Chemin$, _
Title:="Le traitement a réussi"
Erreur:
Set Fichier = Nothing
Set Dossier = Nothing
Set fso = Nothing
Exit Sub
'--------------
MakeFileFNC:
Set Fichier = fso.CreateTextFile(B$)
Fichier.Close
Set Fichier = fs😵penTextFile(B$, 2, False, 0)
Fichier.WriteLine A$
Fichier.Close
Return
End Sub
*************************

Cordialement.

PMO
Patrick Morange

Re : export données vers fichiers texte

Merci Patrick,

Je vais tester cette solution. Entretemps, j'avais trouvé quelque chose en chipotant pas mal.

En tout cas merci d'avoir passé du temps sur ce sujet.

Bien à toi et meilleurs voeux la nouvelle année qui se présente.

A bientôt Titicool