XL 2010 Exporter un onglet en Word

[tvhabdo]

Bonjour a tous, le Forum


J'ai un classeur et je souhaiterais exporter la feuille (onglet) TITRE DE UNE en fichier Word.doc ou au pire en .txt

Je n'ai rien trouvé dans les diférents fil du forum..!!

Merci - Pat

 

[tvhabdo]

Bonjour Pierre, Tatiak

Le bouton fonctionne bien, , je clic, ça lance Word, mais ensuite j'ai une page blanche, on dirait que le "Copier - Coller" ne se fait pas
Merci - pat

 

[job75]

Bonjour tvhabdo, Pierre,

Voyez le fichier joint et cette macro :

Sub Word()
Dim chemin$, nom$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
[A1].CurrentRegion.Copy
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
    .Range.Paste
    .SaveAs chemin & nom
    If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
Application.CutCopyMode = 0
End Sub

A+

 

[tvhabdo]

Comme ceci?
Pierre

Bonjour Pierre/Tatiak

Je travaille avec la macro du fichier Titre de UNE .xlsm du post precedent
Serait il possible de modifier la macro pour obtenir cela ?
Le coller des données dans le fichier Word me donne un tableau
Je souhaiterais avoir dans mon fichier Word du texte au long car ensuite je dois faire des copier/coller, de la relecture, etc

Merci - Pat

 

[job75]

Bonjour,

Je souhaiterais avoir dans mon fichier Word du texte au long

Au long ??? Si vous voulez dire du texte concaténé voyez ce fichier (2) et cette macro :

Sub Word()
Dim chemin$, nom$, c As Range, tablo, ub%, i&, x$, j%, txt$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
tablo = [A1].CurrentRegion 'matrice, plus rapide
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
    x = ""
    For j = 1 To ub
        x = x & ", " & tablo(i, j)
    Next j
    txt = txt & vbLf & Mid(x, 3)
Next i
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
    .Range.Text = Mid(txt, 2)
    .SaveAs chemin & nom
    If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub

A+

 

[tvhabdo]

Bonjour,

Au long ??? Si vous voulez dire du texte concaténé voyez ce fichier (2) et cette macro :

Sub Word()
Dim chemin$, nom$, c As Range, tablo, ub%, i&, x$, j%, txt$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
tablo = [A1].CurrentRegion 'matrice, plus rapide
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
    x = ""
    For j = 1 To ub
        x = x & ", " & tablo(i, j)
    Next j
    txt = txt & vbLf & Mid(x, 3)
Next i
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
    .Range.Text = Mid(txt, 2)
    .SaveAs chemin & nom
    If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub

A+

Hello JOB75, Oui ça fonctionne comme je le souhaite mais dans excel j'ai ce message de DEBOGUE
en rouge

On Error GoTo 0
With WApp.documents.Add
.Range.Text = Mid(txt, 2)
.SaveAs chemin & nom
If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub

 

[job75]

Je ne peux pas vous aider car chez moi aucun bug.

 

[tvhabdo]

Je ne peux pas vous aider car chez moi aucun bug.

JOB75
Du coup j'ai supprimer cette ligne et TOUT fonctionne MAIS
dans ton fichier tu as un tableau, alors que moi dans mon fichier de travail, j'ai tout dans la colonne A
Cet a dire
En A4, j'ai un titre
En A5, j'ai un sous titre
En A7, J'ai un tiret pour faire une sepération
Je joint un extrait de mon fichier

Merci PAT

 

[job75]

Sub Word()
Dim chemin$, nom$, tablo, i&, txt$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
tablo = ActiveSheet.UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then txt = txt & vbLf & tablo(i, 1)
Next i
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
    .Range.Text = Mid(txt, 2)
    .SaveAs chemin & nom
    If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub

 

[job75]

Bonjour tvhabdo, Pierre,

Je viens de m'apercevoir que les fichiers des posts #10 et #11 sont vérolés.

En effet vous remarquerez que dans VBA il s'est inséré une feuille parasite Feuil1 du type ThisWorkbook.

C'est peut-être la raison du bug sur .SaveAs chemin & nom.

J'ai donc reconstruit le fichier à partir d'une feuille vierge, voyez ce que donne ce fichier (2) chez vous.

A+

 

[tvhabdo]

Sub Word()
Dim chemin$, nom$, tablo, i&, txt$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
tablo = ActiveSheet.UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then txt = txt & vbLf & tablo(i, 1)
Next i
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
    .Range.Text = Mid(txt, 2)
    .SaveAs chemin & nom
    If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub

Hello
Merci, JOB je l'ai adapté a mon fichier et c'est TOP
Encore merci - Pat

 

[job75]

Merci, JOB je l'ai adapté a mon fichier et c'est TOP

Alors .SaveAs chemin & nom fonctionne chez vous ?