Bonjour,
A )
Si lors de ton premier retour suite à ma proposition, j'aurais adapt é
la macro immédiatement.
Quand j'ai regardé le format des cellules de la plage désignà ©e, toutes
étaient au format standard sauf la colonne dont tu notes le problà ¨me
qui elle avait le format suivant : -1234 . C'est ce pour quoi tu observes
un résultat erratique comme résultat. Désolé, mais je n'ai pas vérifié
le formatage de chacune des cellules de la plage...
Essaie cette macro, cela devait aller.
'------------------------------------------------------------------------
Sub test()
Dim C As Range, X As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With Worksheets("Feuil1") 'Nom feuille à adapter au besoin
For Each C In .Range("D2:F34").Columns
With C
.NumberFormat = "General"
X = .Value
.Value = ""
.Value = X
End With
Next
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'------------------------------------------------------------------------
B ) Si ton fichier contient plus de données que la plage que tu veux avoir
dans ton fichier .csv,
Copie cette plage de cellules dans un nouveau classeur et lors d'un
enregistrement de ce
fichier, dans la fenêtre enregistrer sous, dans la liste dà ©roulante du
bas de la fenêtre "Type"
choisis le type "CSV (DOS)(*.CSV). Voilà .
Si tu fermes ton fichier, vas dans l'explorateur Windows dans ledit
répertoire, et fais un clic droit
sur le fichier. Avec la commande "Ouvrir avec" du menu contextuel, t u
pourras choisir l'application
"Notepad" ou "Excel" pour ouvrir ce fichier.
MichD
Bonjour,
A )
Si lors de ton premier retour suite à ma proposition, j'aurais adapt é
la macro immédiatement.
Quand j'ai regardé le format des cellules de la plage désignà ©e, toutes
étaient au format standard sauf la colonne dont tu notes le problà ¨me
qui elle avait le format suivant : -1234 . C'est ce pour quoi tu observes
un résultat erratique comme résultat. Désolé, mais je n'ai pas vérifié
le formatage de chacune des cellules de la plage...
Essaie cette macro, cela devait aller.
'------------------------------------------------------------------------
Sub test()
Dim C As Range, X As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With Worksheets("Feuil1") 'Nom feuille à adapter au besoin
For Each C In .Range("D2:F34").Columns
With C
.NumberFormat = "General"
X = .Value
.Value = ""
.Value = X
End With
Next
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'------------------------------------------------------------------------
B ) Si ton fichier contient plus de données que la plage que tu veux avoir
dans ton fichier .csv,
Copie cette plage de cellules dans un nouveau classeur et lors d'un
enregistrement de ce
fichier, dans la fenêtre enregistrer sous, dans la liste dà ©roulante du
bas de la fenêtre "Type"
choisis le type "CSV (DOS)(*.CSV). Voilà .
Si tu fermes ton fichier, vas dans l'explorateur Windows dans ledit
répertoire, et fais un clic droit
sur le fichier. Avec la commande "Ouvrir avec" du menu contextuel, t u
pourras choisir l'application
"Notepad" ou "Excel" pour ouvrir ce fichier.
MichD
Bonjour,
A )
Si lors de ton premier retour suite à ma proposition, j'aurais adapt é
la macro immédiatement.
Quand j'ai regardé le format des cellules de la plage désignà ©e, toutes
étaient au format standard sauf la colonne dont tu notes le problà ¨me
qui elle avait le format suivant : -1234 . C'est ce pour quoi tu observes
un résultat erratique comme résultat. Désolé, mais je n'ai pas vérifié
le formatage de chacune des cellules de la plage...
Essaie cette macro, cela devait aller.
'------------------------------------------------------------------------
Sub test()
Dim C As Range, X As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With Worksheets("Feuil1") 'Nom feuille à adapter au besoin
For Each C In .Range("D2:F34").Columns
With C
.NumberFormat = "General"
X = .Value
.Value = ""
.Value = X
End With
Next
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'------------------------------------------------------------------------
B ) Si ton fichier contient plus de données que la plage que tu veux avoir
dans ton fichier .csv,
Copie cette plage de cellules dans un nouveau classeur et lors d'un
enregistrement de ce
fichier, dans la fenêtre enregistrer sous, dans la liste dà ©roulante du
bas de la fenêtre "Type"
choisis le type "CSV (DOS)(*.CSV). Voilà .
Si tu fermes ton fichier, vas dans l'explorateur Windows dans ledit
répertoire, et fais un clic droit
sur le fichier. Avec la commande "Ouvrir avec" du menu contextuel, t u
pourras choisir l'application
"Notepad" ou "Excel" pour ouvrir ce fichier.
MichD
Bonjour,
Pour créer ton fichier texte avec comme séparateur le point-vir gule,
utilise cette macro.
'------------------------------------------------------------------------
Sub SaveAsTextFile()
Dim C As Variant, fFileName As String
Dim A As Integer, B As Integer
Dim Tmp As String, Sep As String
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
NomFichier = "SonNom.txt" 'nom du fichier à créer
Sep = ";" 'le séparateur dans le fichier texte
'Le fichier texte sera créé dans le même répertoire q ue le classeur
'Tu peux remplacer "Thisworkbook.path" par le chemin que tu désires.
'Cependant ce chemin doit exister.
fFileName = ThisWorkbook.Path & "" & NomFichier
Open fFileName For Output As #1
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Close #1
Erase C
End Sub
'------------------------------------------------------------------------
MichD
Bonjour,
Pour créer ton fichier texte avec comme séparateur le point-vir gule,
utilise cette macro.
'------------------------------------------------------------------------
Sub SaveAsTextFile()
Dim C As Variant, fFileName As String
Dim A As Integer, B As Integer
Dim Tmp As String, Sep As String
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
NomFichier = "SonNom.txt" 'nom du fichier à créer
Sep = ";" 'le séparateur dans le fichier texte
'Le fichier texte sera créé dans le même répertoire q ue le classeur
'Tu peux remplacer "Thisworkbook.path" par le chemin que tu désires.
'Cependant ce chemin doit exister.
fFileName = ThisWorkbook.Path & "" & NomFichier
Open fFileName For Output As #1
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Close #1
Erase C
End Sub
'------------------------------------------------------------------------
MichD
Bonjour,
Pour créer ton fichier texte avec comme séparateur le point-vir gule,
utilise cette macro.
'------------------------------------------------------------------------
Sub SaveAsTextFile()
Dim C As Variant, fFileName As String
Dim A As Integer, B As Integer
Dim Tmp As String, Sep As String
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
NomFichier = "SonNom.txt" 'nom du fichier à créer
Sep = ";" 'le séparateur dans le fichier texte
'Le fichier texte sera créé dans le même répertoire q ue le classeur
'Tu peux remplacer "Thisworkbook.path" par le chemin que tu désires.
'Cependant ce chemin doit exister.
fFileName = ThisWorkbook.Path & "" & NomFichier
Open fFileName For Output As #1
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Close #1
Erase C
End Sub
'------------------------------------------------------------------------
MichD
Bonjour MichD,
Merci c'est exactement ce qu'il me fallait.
N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
Ce serait la cerise sur le gâteau en cette fin d'année.
Je vous souhaite à tous de très bonnes Fêtes.
Régis
Bonjour MichD,
Merci c'est exactement ce qu'il me fallait.
N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
Ce serait la cerise sur le gâteau en cette fin d'année.
Je vous souhaite à tous de très bonnes Fêtes.
Régis
Bonjour MichD,
Merci c'est exactement ce qu'il me fallait.
N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
Ce serait la cerise sur le gâteau en cette fin d'année.
Je vous souhaite à tous de très bonnes Fêtes.
Régis
bonjour Régis,
regarde du coté,
Application.FileDialog(msoFileDialogFilePicker)
je te souhaite de très joyeuse fête à toi et ta famille également
Dim dialog As Object
Dim pickedfile As Boolean
Dim myfile As String
Set dialog = Application.FileDialog(msoFileDialogFilePicker)
With dialog
.AllowMultiSelect = False
.Title = "Please pick the file to convert."
.Filters.Clear
.Filters.Add "Text Files", "*.TXT"
' .Filters.Add "All Files", "*.*"
pickedfile = False
pickedfile = .Show
If pickedfile Then
myfile = .SelectedItems.Item(1)
End If
End With
'--------
isabellle
Le 2016-12-23 à 20:03, f4crw a écrit :Bonjour MichD,
Merci c'est exactement ce qu'il me fallait.
N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
Ce serait la cerise sur le gâteau en cette fin d'année.
Je vous souhaite à tous de très bonnes Fêtes.
Régis
bonjour Régis,
regarde du coté,
Application.FileDialog(msoFileDialogFilePicker)
je te souhaite de très joyeuse fête à toi et ta famille également
Dim dialog As Object
Dim pickedfile As Boolean
Dim myfile As String
Set dialog = Application.FileDialog(msoFileDialogFilePicker)
With dialog
.AllowMultiSelect = False
.Title = "Please pick the file to convert."
.Filters.Clear
.Filters.Add "Text Files", "*.TXT"
' .Filters.Add "All Files", "*.*"
pickedfile = False
pickedfile = .Show
If pickedfile Then
myfile = .SelectedItems.Item(1)
End If
End With
'--------
isabellle
Le 2016-12-23 à 20:03, f4crw a écrit :
> Bonjour MichD,
> Merci c'est exactement ce qu'il me fallait.
>
> N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
> Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
> Ce serait la cerise sur le gâteau en cette fin d'année.
> Je vous souhaite à tous de très bonnes Fêtes.
>
> Régis
>
bonjour Régis,
regarde du coté,
Application.FileDialog(msoFileDialogFilePicker)
je te souhaite de très joyeuse fête à toi et ta famille également
Dim dialog As Object
Dim pickedfile As Boolean
Dim myfile As String
Set dialog = Application.FileDialog(msoFileDialogFilePicker)
With dialog
.AllowMultiSelect = False
.Title = "Please pick the file to convert."
.Filters.Clear
.Filters.Add "Text Files", "*.TXT"
' .Filters.Add "All Files", "*.*"
pickedfile = False
pickedfile = .Show
If pickedfile Then
myfile = .SelectedItems.Item(1)
End If
End With
'--------
isabellle
Le 2016-12-23 à 20:03, f4crw a écrit :Bonjour MichD,
Merci c'est exactement ce qu'il me fallait.
N'y a-t-il pas une possibilité de lancer une boite pour choisir et récupérer le dossier et d'y entrer le nom de fichier txt ?
Un peu comme Application.Dialogs(xlDialogSaveAs).Show mais pour le txt
Ce serait la cerise sur le gâteau en cette fin d'année.
Je vous souhaite à tous de très bonnes Fêtes.
Régis
Bonjour,
Essaie ceci :
'---------------------------------------------------------------------
Sub SaveAsTextFile()
Dim Répertoire As String, Chemin As String
Dim fFileName As Variant, C As Variant
Dim A As Integer, B As Integer, X As Variant
Dim Tmp As String, Sep As String
Dim Rg As Range, Are As Range
Do
Do
'Nom du fichier
If Répertoire <> "" Then
fFileName = Application.InputBox(Prompt:="Ce nom de" & _
" fichier existe déjà ." & vbCrLf & _
"Choisissez un autre nom que """ & fFileName & """.", _
Title:="Nom du fichier texte à définir", Type:= 3)
Else
fFileName = Application.InputBox(Prompt:="Saisir le " & _
"nom du fichier texte à créer." _
, Title:="Nom du fichier texte à définir", Type: =3)
End If
'S'assurer que le nom du fichier ne contient pas un des symboles
'interdits par Microsoft / : * ? > < |
X = CheckName(fFileName)
If X = False Then
MsgBox "Le nom du fichier ne peut pas contenir " & vbCrLf & _
"l'un ces symboles suivants : / : * ? > < | " & _
vbCrLf & vbCrLf & "Corriger.", vbCritical, "Attention"
End If
Loop Until X = True
If TypeName(fFileName) <> "Boolean" Then
'S'assurer de la présence de l'extension du fichier
If LCase(Right(fFileName, 4)) <> ".txt" Then
fFileName = fFileName & ".txt"
End If
'Si l'usager clique sur le bouton annuler de la fenêtre
Else
MsgBox "Opération annulée. Nom de fichier non défi ni.", _
vbOKOnly + vbInformation, "Opération annulée"
Exit Sub
End If
If Répertoire = "" Then
Do
'Choix du répertoire où le fichier sera créé
Répertoire = BrowseFile(Chemin)
Loop Until Dir(Répertoire, vbDirectory) <> ""
End If
'Teste pour déterminer si un tel fichier existe déjÃ
'dans le répertoire retenu...
X = Dir(Répertoire & "" & fFileName)
DoEvents
Loop Until X = ""
'Sélection de l'usager de la plage de cellules à insérer d ans
'le fichier texte. 'il est possible de sélectionner plusieurs
'plages de cellules DANS LA MÃME FEUILLE en les séparant par un
'point-virgule dans la zone de saisie à l'aide de la souris.
X = Application.InputBox(Prompt:="Sélectionner la plage de cellu les.", _
Title:="Votre sélection", Type:=8).Addre ss
If TypeName(X) = "Boolean" Then
'Si l'usager clique sur le bouton annulé
MsgBox "Vous avez décidé d'annuler l'opération en cour s.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
Else
'Si l'usager a réellement sélectionné une ou des plages de cellules
'DANS LA MÃME FEUILLE
Set Rg = Range(X)
End If
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
Sep = ";" 'le séparateur dans le fichier texte
Open Répertoire & "" & fFileName For Output As #1
For Each Are In Rg.Areas
C = Are.Value
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Erase C
Next
Close #1
End Sub
'---------------------------------------------------------------------
Function CheckName(fFileName As Variant) As Boolean
'Vérification des caractères du nom de fichier
Dim X(), Elt As Variant
X = Array("", "/", ":", "*", "?", ">", "<", "|")
For Each Elt In X
If InStr(1, fFileName, Elt, vbTextCompare) > 0 Then
CheckName = False
Exit Function
End If
Next
CheckName = True
End Function
'---------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisissez le répertoire de destination du fichier.. ."
'Empêcher la multi-sélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par dà ©faut
.InitialFileName = Chemin
'Affiche la boîte de dialogue
.Show
'Si un répertoire a été sélectionné
'par défaut le répertoire en cours à l'ouverture de la fenêtre
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------------------------------
MichD
Bonjour,
Essaie ceci :
'---------------------------------------------------------------------
Sub SaveAsTextFile()
Dim Répertoire As String, Chemin As String
Dim fFileName As Variant, C As Variant
Dim A As Integer, B As Integer, X As Variant
Dim Tmp As String, Sep As String
Dim Rg As Range, Are As Range
Do
Do
'Nom du fichier
If Répertoire <> "" Then
fFileName = Application.InputBox(Prompt:="Ce nom de" & _
" fichier existe déjà ." & vbCrLf & _
"Choisissez un autre nom que """ & fFileName & """.", _
Title:="Nom du fichier texte à définir", Type:= 3)
Else
fFileName = Application.InputBox(Prompt:="Saisir le " & _
"nom du fichier texte à créer." _
, Title:="Nom du fichier texte à définir", Type: =3)
End If
'S'assurer que le nom du fichier ne contient pas un des symboles
'interdits par Microsoft / : * ? > < |
X = CheckName(fFileName)
If X = False Then
MsgBox "Le nom du fichier ne peut pas contenir " & vbCrLf & _
"l'un ces symboles suivants : / : * ? > < | " & _
vbCrLf & vbCrLf & "Corriger.", vbCritical, "Attention"
End If
Loop Until X = True
If TypeName(fFileName) <> "Boolean" Then
'S'assurer de la présence de l'extension du fichier
If LCase(Right(fFileName, 4)) <> ".txt" Then
fFileName = fFileName & ".txt"
End If
'Si l'usager clique sur le bouton annuler de la fenêtre
Else
MsgBox "Opération annulée. Nom de fichier non défi ni.", _
vbOKOnly + vbInformation, "Opération annulée"
Exit Sub
End If
If Répertoire = "" Then
Do
'Choix du répertoire où le fichier sera créé
Répertoire = BrowseFile(Chemin)
Loop Until Dir(Répertoire, vbDirectory) <> ""
End If
'Teste pour déterminer si un tel fichier existe déjÃ
'dans le répertoire retenu...
X = Dir(Répertoire & "" & fFileName)
DoEvents
Loop Until X = ""
'Sélection de l'usager de la plage de cellules à insérer d ans
'le fichier texte. 'il est possible de sélectionner plusieurs
'plages de cellules DANS LA MÃME FEUILLE en les séparant par un
'point-virgule dans la zone de saisie à l'aide de la souris.
X = Application.InputBox(Prompt:="Sélectionner la plage de cellu les.", _
Title:="Votre sélection", Type:=8).Addre ss
If TypeName(X) = "Boolean" Then
'Si l'usager clique sur le bouton annulé
MsgBox "Vous avez décidé d'annuler l'opération en cour s.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
Else
'Si l'usager a réellement sélectionné une ou des plages de cellules
'DANS LA MÃME FEUILLE
Set Rg = Range(X)
End If
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
Sep = ";" 'le séparateur dans le fichier texte
Open Répertoire & "" & fFileName For Output As #1
For Each Are In Rg.Areas
C = Are.Value
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Erase C
Next
Close #1
End Sub
'---------------------------------------------------------------------
Function CheckName(fFileName As Variant) As Boolean
'Vérification des caractères du nom de fichier
Dim X(), Elt As Variant
X = Array("", "/", ":", "*", "?", ">", "<", "|")
For Each Elt In X
If InStr(1, fFileName, Elt, vbTextCompare) > 0 Then
CheckName = False
Exit Function
End If
Next
CheckName = True
End Function
'---------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisissez le répertoire de destination du fichier.. ."
'Empêcher la multi-sélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par dà ©faut
.InitialFileName = Chemin
'Affiche la boîte de dialogue
.Show
'Si un répertoire a été sélectionné
'par défaut le répertoire en cours à l'ouverture de la fenêtre
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------------------------------
MichD
Bonjour,
Essaie ceci :
'---------------------------------------------------------------------
Sub SaveAsTextFile()
Dim Répertoire As String, Chemin As String
Dim fFileName As Variant, C As Variant
Dim A As Integer, B As Integer, X As Variant
Dim Tmp As String, Sep As String
Dim Rg As Range, Are As Range
Do
Do
'Nom du fichier
If Répertoire <> "" Then
fFileName = Application.InputBox(Prompt:="Ce nom de" & _
" fichier existe déjà ." & vbCrLf & _
"Choisissez un autre nom que """ & fFileName & """.", _
Title:="Nom du fichier texte à définir", Type:= 3)
Else
fFileName = Application.InputBox(Prompt:="Saisir le " & _
"nom du fichier texte à créer." _
, Title:="Nom du fichier texte à définir", Type: =3)
End If
'S'assurer que le nom du fichier ne contient pas un des symboles
'interdits par Microsoft / : * ? > < |
X = CheckName(fFileName)
If X = False Then
MsgBox "Le nom du fichier ne peut pas contenir " & vbCrLf & _
"l'un ces symboles suivants : / : * ? > < | " & _
vbCrLf & vbCrLf & "Corriger.", vbCritical, "Attention"
End If
Loop Until X = True
If TypeName(fFileName) <> "Boolean" Then
'S'assurer de la présence de l'extension du fichier
If LCase(Right(fFileName, 4)) <> ".txt" Then
fFileName = fFileName & ".txt"
End If
'Si l'usager clique sur le bouton annuler de la fenêtre
Else
MsgBox "Opération annulée. Nom de fichier non défi ni.", _
vbOKOnly + vbInformation, "Opération annulée"
Exit Sub
End If
If Répertoire = "" Then
Do
'Choix du répertoire où le fichier sera créé
Répertoire = BrowseFile(Chemin)
Loop Until Dir(Répertoire, vbDirectory) <> ""
End If
'Teste pour déterminer si un tel fichier existe déjÃ
'dans le répertoire retenu...
X = Dir(Répertoire & "" & fFileName)
DoEvents
Loop Until X = ""
'Sélection de l'usager de la plage de cellules à insérer d ans
'le fichier texte. 'il est possible de sélectionner plusieurs
'plages de cellules DANS LA MÃME FEUILLE en les séparant par un
'point-virgule dans la zone de saisie à l'aide de la souris.
X = Application.InputBox(Prompt:="Sélectionner la plage de cellu les.", _
Title:="Votre sélection", Type:=8).Addre ss
If TypeName(X) = "Boolean" Then
'Si l'usager clique sur le bouton annulé
MsgBox "Vous avez décidé d'annuler l'opération en cour s.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
Else
'Si l'usager a réellement sélectionné une ou des plages de cellules
'DANS LA MÃME FEUILLE
Set Rg = Range(X)
End If
With Worksheets("Feuil1") 'adapte le nom de la feuille si nécessaire
C = .Range("A2:H34") 'Adapte la plage de cellules.
End With
Sep = ";" 'le séparateur dans le fichier texte
Open Répertoire & "" & fFileName For Output As #1
For Each Are In Rg.Areas
C = Are.Value
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Erase C
Next
Close #1
End Sub
'---------------------------------------------------------------------
Function CheckName(fFileName As Variant) As Boolean
'Vérification des caractères du nom de fichier
Dim X(), Elt As Variant
X = Array("", "/", ":", "*", "?", ">", "<", "|")
For Each Elt In X
If InStr(1, fFileName, Elt, vbTextCompare) > 0 Then
CheckName = False
Exit Function
End If
Next
CheckName = True
End Function
'---------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisissez le répertoire de destination du fichier.. ."
'Empêcher la multi-sélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par dà ©faut
.InitialFileName = Chemin
'Affiche la boîte de dialogue
.Show
'Si un répertoire a été sélectionné
'par défaut le répertoire en cours à l'ouverture de la fenêtre
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------------------------------
MichD
