XL 2010 créer word docs et transfért données

[yahya belbachir]

Bonjour
je veux un code pour:
transférer les données d'une page excel vers word.doc inexistant.
mon fichier de test çi joint
merci

 

[xUpsilon]

Bonjour,

Voir ci-joint, mais comme tu ne précises pas quelle cellule tu veux copier/coller, ni dans quel format ni rien d'autre, il est difficile d'adapter ta demande.
Voici donc une macro qui fait un Copier/Coller bête et méchant de la zone A3:E33.

Bonne continuation

 

[yahya belbachir]

Bonjour,

Voir ci-joint, mais comme tu ne précises pas quelle cellule tu veux copier/coller, ni dans quel format ni rien d'autre, il est difficile d'adapter ta demande.
Voici donc une macro qui fait un Copier/Coller bête et méchant de la zone A3:E33.

Bonne continuation

merci pour votre réponse,c'est très bon,
ça j'ai oublié de le faire,mes explications sont insuffisantes.
est ce possible de dire comment faire le tableau dans la deuxiéme page
j'ai fais seulement un exemple ici,dans mon travail j'aurai besoin de deux pages,le tableau dans la deuxième page word,même l'écriture de la page 1 est courte. il y a aussi une possiblilité que la page word s'enregistre automatiquement dans le bureau ou avec l'emplacement du fichier Word
et merci infiniment pour votre aide.

j'ai pris ce code pour l'enregistrement mais je ne sais pas coment le faire pour enregistrer automatiquement:
Rep = thisworkbook.Path & "\Word\"
If Not Exist_Rep(Rep) Then MkDir Rep

Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Add
Ndf = Rep & "Fiche_" & Format(Now(), "yyyyMMdd_hhmm") & ".docx"

 

[xUpsilon]

Re,

Pour coller le tableau en tant qu'image et ainsi pouvoir le redimensionner :

Selection.PasteSpecial DataType:=wdPasteBitmap

Sinon, il va falloir être plus précis sur ce que tu veux changer dans ton tableau.
Pour copier le tableau au début de la deuxième page (si elle existe déjà) : il faut avoir un signet placé au début de la deuxième page, et atteindre ce signet et coller à cet endroit.
Pour que le document word s'enregistre automatiquement à la fermeture :

ThisDocument.Close SaveChanges:=True

 

[yahya belbachir]

Re,

Pour coller le tableau en tant qu'image et ainsi pouvoir le redimensionner :

Selection.PasteSpecial DataType:=wdPasteBitmap

Sinon, il va falloir être plus précis sur ce que tu veux changer dans ton tableau.
Pour copier le tableau au début de la deuxième page (si elle existe déjà) : il faut avoir un signet placé au début de la deuxième page, et atteindre ce signet et coller à cet endroit.
Pour que le document word s'enregistre automatiquement à la fermeture :

ThisDocument.Close SaveChanges:=True

j'ai trouvé un code venant de Tatiak
par exemple:
une feuille qui contient des paragraphes et un tableaux,en un clique sur le bouton, le code, crée un fichier, et chaque clique crée un doc woed renommé avec le contenu de la feuillle excel, c'est ce que vraiment j'imagine faire.
merci
le code Tatiak
Public Const wdAlignParagraphLeft = 0
Public Const wdAlignParagraphCenter = 1
Public Const wdAlignParagraphRight = 2
Public Const wdAlignParagraphJustify = 3

Public Const wdPageBreak = 7

Public Const wdBorderTop = -1
Public Const wdBorderLeft = -2
Public Const wdBorderBottom = -3
Public Const wdBorderRight = -4


Sub Creer_Word()
Dim WordApp As Object, WordDoc As Object, Rng As Object
Dim Rep As String, Ndf As String, Logo As String
Dim i As Integer, j As Integer
Dim Total As Single

On Error GoTo errhdlr
Rep = Application.DefaultFilePath & "\Word\"
If Not Exist_Rep(Rep) Then MkDir Rep

Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Add
Ndf = Rep & "Fiche_" & Format(Now(), "yyyyMMdd_hhmm") & ".docx"

With WordDoc
' Mise en page : Marges
With .PageSetup
.LeftMargin = WordApp.CentimetersToPoints(1.5)
.RightMargin = WordApp.CentimetersToPoints(1.5)
.TopMargin = WordApp.CentimetersToPoints(2)
.BottomMargin = WordApp.CentimetersToPoints(2)
End With

' Ajoute un logo s'il existe (fichier Logo.gif placé dans MesDocuments)
Logo = Application.DefaultFilePath & "\Logo.gif"
If Exist_Fichier(Logo) Then
.Paragraphs.Add
.InlineShapes.AddPicture (Logo)
End If

' Ajoute un titre
.Paragraphs.Add
With .Paragraphs(.Paragraphs.Count - 1)
.Range.Text = "TITRE DU DOCUMENT"
.Range.Font.Bold = True
.Range.Font.Underline = True
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Format.SpaceAfter = 18
.Range.InsertAfter (vbCrLf) ' ou bien .Range.InsertParagraphAfter()
End With

' Ajoute un signet
.Paragraphs.Add
With .Paragraphs(.Paragraphs.Count - 1)
.Range.Font.Bold = False
.Range.Font.Underline = False
.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
Set Rng = WordDoc.Range(Start:=.Range.Start, End:=.Range.Start)
End With
.Bookmarks.Add Range:=Rng, Name:="Signet1"

' ajoute le(s) paragraphe(s) de la colonne A si coché(s) en colonne B
For i = 2 To 6
If ActiveSheet.Range("B" & i) = "x" Then
.Paragraphs.Add
With .Paragraphs(.Paragraphs.Count - 1)
.Range.Text = ActiveSheet.Range("A" & i)
.Range.Font.Bold = False
.Range.Font.Underline = False
.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
.Range.ParagraphFormat.FirstLineIndent = WordApp.CentimetersToPoints(1.25)
.Format.SpaceAfter = 8
.Range.InsertAfter (vbCrLf)
End With
End If
Next i

' passe une ligne
.Paragraphs.Add

' insère un saut de page
.Paragraphs(.Paragraphs.Count - 1).Range.InsertBreak Type:=wdPageBreak

' passe une ligne
.Paragraphs.Add

' Ajoute un tableau de 3 lignes (les lignes suivantes sont créées en fonction des besoins)
.Paragraphs.Add
With .Paragraphs(.Paragraphs.Count - 1)
.Range.Font.Bold = False
.Range.Font.Underline = False
.Format.SpaceBefore = 2
.Format.SpaceAfter = 2
Set Rng = WordDoc.Range(Start:=.Range.Start, End:=.Range.Start)
End With

With .Tables.Add(Range:=Rng, NumRows:=3, NumColumns:=5)
' ajuste la largeur des colonnes
.Columns.Item(1).Width = WordApp.CentimetersToPoints(1.8)
.Columns.Item(2).Width = WordApp.CentimetersToPoints(2.6)
.Columns.Item(3).Width = WordApp.CentimetersToPoints(6)
.Columns.Item(4).Width = WordApp.CentimetersToPoints(3)
.Columns.Item(5).Width = WordApp.CentimetersToPoints(4.5)

' fusionne les cases de la ligne 1 et ajoute un titre au tableau
For i = 1 To 4
.cell(1, 1).Merge MergeTo:=.cell(1, 2)
Next i
With .cell(1, 1)
.Range.Text = "TITRE DU TABLEAU"
.Range.Shading.BackgroundPatternColor = -738132071
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Bold = True
.Borders.Enable = True
End With

' complète et formate les entêtes
For j = 1 To 5
With .cell(2, j)
.Range.Text = ActiveSheet.Cells(1, j + 3)
.Range.Shading.BackgroundPatternColor = -603923969 '-738132071
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Bold = True
.Borders.Enable = True
' .Borders(wdBorderTop).LineStyle = 1
' .Borders(wdBorderLeft).LineStyle = 1
' .Borders(wdBorderRight).LineStyle = 1
' .Borders(wdBorderBottom).LineStyle = 1
End With
Next j

' complète et formate les lignes de données
Total = ActiveSheet.Cells(2, "H").Value
For i = 3 To 7
For j = 1 To 5
With .cell(i, j)
.Range.Text = ActiveSheet.Cells(i - 1, j + 3).Text
.Borders.Enable = True
'.Borders(wdBorderTop).LineStyle = 1
'.Borders(wdBorderLeft).LineStyle = 1
'.Borders(wdBorderRight).LineStyle = 1
'.Borders(wdBorderBottom).LineStyle = 1
End With
Next j

' aligne les données
.cell(i, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.cell(i, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.cell(i, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.cell(i, 5).Range.ParagraphFormat.Alignment = wdAlignParagraphRight

' totalise les montants
Total = Total + ActiveSheet.Cells(i, "H").Value

' ajoute la ligne suivante
.Rows.Add
Next

For j = 1 To 2
.cell(i + 1, 1).Merge MergeTo:=.cell(i + 1, 2)
Next j
With .cell(i + 1, 1)
.Borders(wdBorderLeft).LineStyle = 0
.Borders(wdBorderRight).LineStyle = 0
.Borders(wdBorderBottom).LineStyle = 0
End With
' Inscrit le total final en gras, en rouge et au format monétaire
.cell(i + 1, 2).Range.Text = "Total :"
.cell(i + 1, 2).Range.Font.Bold = True
.cell(i + 1, 2).Range.Font.Color = RGB(200, 10, 10)
.cell(i + 1, 2).Borders(wdBorderLeft).LineStyle = 1
.cell(i + 1, 3).Range.Text = Format(Total, "# ###.00 €")
.cell(i + 1, 3).Range.Font.Bold = True
.cell(i + 1, 2).Range.Font.Color = RGB(200, 10, 10)
End With

' dernier paragraphe : "Edité le"
.Paragraphs.Add
With .Paragraphs(.Paragraphs.Count - 1)
.Range.Text = "Edité le : " & Format(Now(), "dd/MM/yyyy HH:mm")
.Range.Font.Italic = True
.Range.Font.Underline = False
.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
End With

End With

WordDoc.Application.ActiveDocument.SaveAs (Ndf)
WordApp.Visible = True ' ou bien => WordApp.Application.Quit

Set Rng = Nothing
Set WordDoc = Nothing
Set WordApp = Nothing

MsgBox "Document Word généré!"
Exit Sub

errhdlr:
Set Rng = Nothing
Set WordDoc = Nothing
Set WordApp = Nothing
Debug.Print Err.Description
End Sub


Function Exist_Rep(Ndf As String) As Boolean
On Error Resume Next
Exist_Rep = GetAttr(Ndf) And vbDirectory
End Function


Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object

Set tatiak = CreateObject("Scripting.FileSystemObject")
Exist_Fichier = tatiak.FileExists(S)
Set tatiak = Nothing
End Function

 

[xUpsilon]

Bonjour,

Pense à utiliser les balises de Code quand tu veux en écrire un, sinon ça rend la lecture très compliquée. D'autre part, le code présent ici est relativement long, donc sans balises, ça devient un véritable enfer à lire (d'autant plus que je ne sais toujours pas ce que tu veux faire de ce bout de code).

Bonne continuation