XL 2010 Probleme sur code vba export

bredeche

XLDnaute Occasionnel
Bonjour,

mon code fonctionne mais d' est qu'il est utiliser par une autre personne sur un autre poste le code Open "D:\CBREDECHE\Bureau\testexcel.csv" For Output As #1 'a changer pour les autre pc'
ne fonctionne pas "normal" ,que faut il que je mette pour que n'importe quel personne qui utilise le fichier puisse enregistre export ou il veux "fenêtre de commande enregistrement"

trouvez ci dessous mon code
merci par avance





Code:
Sub ExportCSV()

Dim LigneCSV As String
Dim PlageCSV As Range
Dim Ligne As Integer, Colonne As Integer, Nb_Ligne As Integer, Nb_Colonne As Integer


'Fermeture ficher si ouvert
Close

'Plage CSV
Set PlageCSV = Worksheets("Donné équipement").Range("A1:T650")

'Ouverture du fichier de sortie
Open "D:\CBREDECHE\Bureau\testexcel.csv" For Output As #1 'a changer pour les autre pc'

'Butees de comptage
Nb_Ligne = PlageCSV.Rows.Count
Nb_Colonne = PlageCSV.Columns.Count

'Boucle sur la plage et ajoute les lignes au fichier
For Ligne = 1 To Nb_Ligne
For Colonne = 1 To Nb_Colonne
If LigneCSV <> "" Then
LigneCSV = LigneCSV & ";"
End If
'construction ligne
LigneCSV = LigneCSV & PlageCSV.Cells(Ligne, Colonne).Value
Next Colonne
'Enregistrement ligne
Print #1, LigneCSV
LigneCSV = ""
Next Ligne

'Fermeture du fichier
Close #1

End Sub
 

Roland_M

XLDnaute Barbatruc
Bonsoir,

Code:
Sub ExportCSV()

Dim LigneCSV As String, Chemin$, Fichier$, CheminFichier$, NoFich%
Dim PlageCSV As Range
Dim Ligne As Integer, Colonne As Integer, Nb_Ligne As Integer, Nb_Colonne As Integer

'------- saisie du chemin ------------------
Fichier$ = "testexcel.csv" '< nom du fichier
Chemin$ = FLoadNomDuREP '< saisie du chemin
If Chemin$ = "" Then Exit Sub
If Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
CheminFichier$ = Chemin$ & Fichier$
If MsgBox(CheminFichier$ & vbLf & vbLf & "Veuillez confirmer ?", vbQuestion + vbYesNo, "") <> vbYes Then Exit Sub
'-----------------------

'Fermeture ficher si ouvert
Close

'Plage CSV
Set PlageCSV = Worksheets("Donné équipement").Range("A1:T650")

'Ouverture du fichier de sortie
NoFich = FreeFile 'no de fichier inutilsé !
Open CheminFichier$ For Output As #NoFich

'Butees de comptage
Nb_Ligne = PlageCSV.Rows.Count
Nb_Colonne = PlageCSV.Columns.Count

'Boucle sur la plage et ajoute les lignes au fichier
For Ligne = 1 To Nb_Ligne
For Colonne = 1 To Nb_Colonne
If LigneCSV <> "" Then
LigneCSV = LigneCSV & ";"
End If
'construction ligne
LigneCSV = LigneCSV & PlageCSV.Cells(Ligne, Colonne).Value
Next Colonne
'Enregistrement ligne
Print #NoFich, LigneCSV
LigneCSV = ""
Next Ligne

'Fermeture du fichier
Close #NoFich

End Sub

'select la petite boite ouvrir dossier (sans fonction ni référence spéciale)
'param en bout , &H1&  )avec le bouton "créer un nouveau dossier"
'------------- , &H201&)sans le bouton "...
Function FLoadNomDuREP() As String 'saisie un chemin
M$ = "Sélectionnez un dossier"
Dim ObjFolder As Object, Chemin As String
Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(&H0&, M$, &H201&, "")
If Not ObjFolder Is Nothing Then
   Chemin = ObjFolder.Items.Item.Path
   On Error Resume Next: Err.Clear 'test si le Rep est valide ?
   Set ObjFolder = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
   If Err Then MsgBox "Répertoire non valide !?": Chemin = ""
   On Error GoTo 0: Err.Clear
Else: Chemin = ""
End If
FLoadNomDuREP = Chemin
Set ObjFolder = Nothing
End Function
 

Discussions similaires

Réponses
2
Affichages
439

Statistiques des forums

Discussions
312 114
Messages
2 085 432
Membres
102 889
dernier inscrit
monsef JABBOUR