Code VBA sauvegarde en prn

Résolu/Fermé
sygmajf99 Messages postés 14 Date d'inscription lundi 10 janvier 2011 Statut Membre Dernière intervention 6 juillet 2012 - 21 nov. 2011 à 20:51
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 21 nov. 2011 à 23:50
Bonjour,

J'ai trouvé un code pour sauver mon onglet en excel sur .prn, i.e. que le délimitateur est un espace.

Tout fonctionne à l'exception que mon code ajoute un espace pour chaque colonne. Je ne sais pas où cette étape se trouve dans mon code, afin de l'éliminer.

Pouvez-vous m'aider.

Le voici :

Sub ExportText()

Dim delimiter As String
Dim quotes As Integer
Dim Returned As String

delimiter = ""

quotes = vbNo

' Call the WriteFile function passing the delimiter and quotes options.
Returned = WriteFile(delimiter, quotes)

' Print a message box indicating if the process was completed.
Select Case Returned
Case "Canceled"
MsgBox "Cancelled"
Case "Exported"
MsgBox "Succeded"
End Select

End Sub

'-------------------------------------------------------------------

Function WriteFile(delimiter As String, quotes As Integer) As String

' Dimension variables to be used in this function.
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double


' Show Save As dialog box with the .TXT file name as the default.
' Test to see what kind of system this macro is being run on.
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"Space Delimited (*.prn), *.prn", , "Space Delimited Exporter")
Else
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"SPACE", , "Space Delimited Exporter")
End If

' Check to see if Cancel was clicked.
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
' Obtain the next free file number.
FNum = FreeFile()

' Open the selected file name for data output.
Open SaveFileName For Output As #FNum

' Store the total number of rows and columns to variables.
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count

' Loop through every cell, from left to right and top to bottom.
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
' Store the current cells contents to a variable.
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
Case xlCenter
CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
Space(Abs(ColWidth - Len(.Text)) / 2)
Case Else
CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
End Select
End With
' Write the contents to the file.
' With or without quotation marks around the cell information.
Select Case quotes
Case vbYes
CellText = Chr(34) & CellText & Chr(34) & delimiter
Case vbNo
CellText = CellText & delimiter
End Select
Print #FNum, CellText;

' Update the status bar with the progress.
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

' Loop to the next column.
Next ColNum
' Add a linefeed character at the end of each row.
If RowNum <> TotalRows Then Print #FNum, ""
' Loop to the next row.
Next RowNum

' Close the .prn file.
Close #FNum

' Reset the status bar.
Application.StatusBar = False
WriteFile = "Exported"
End Function
A voir également:

2 réponses

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
21 nov. 2011 à 23:39
bonjour,

Je ne sais pas où cette étape se trouve dans mon code, afin de l'éliminer.

Je comprends ton souci mais tu nous files un gros pavé brut de fonderie avec de vieilles instructions conservées en commentaire.

Tu trouves que c'est difficile de chercher sans doute, mais pour nous, encore plus !

Commences par épurer ton code afin de le rendre plus lisible et peut-être quelqu'un regardera car comme tu nous le donnes cela ne donne pas envie d'abîmer nos yeux.

Le code en anglais comme excel, mais tu peux mettre les commentaires en français, sinon tu vas sur un site américain.
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 21/11/2011 à 23:50
« Tout fonctionne à l'exception que mon code ajoute un espace pour chaque colonne »
Vu que le délimiteur est l'espace cela me semble normal !
0