Copier range et coller dans mail
non c'est faux Steelson ca ne gere pas les fusions regarde le code html que j'obtient avec ton code
je n'ai pas dit que je gérais les fusions, j'ai dit qu'il n'était pas nécessaire de défusionner pour avoir in fine les bonnes données dans le mail
@ Steelson: je n'ai pas le souhait de passer par tel ou tel système et n'ai pas la prétention de croire que celui-ci ou celui-la est plus performant ou plus optimisé que l'autre , je souhaite juste que cela fonctionne :) mais je suis cependant pret à en tester plusieurs pour en voir leur fonctionnement
@Patrick, cela me fonctionne bien cependant je perd tout de même la mise en forme en montant € pour ma dernière colonne.
Aussi peut on changer le format d'une colonne ou plusieurs du reste?
merci à vous tous pour vos contributions respectives en tout cas
re
oui mais le html est tres strict
pour une balise "table" si c'est pas formatter comme excel en language html +css ben tu a des resultats surprenant (quoi que )
donc je reprends ton code "leger" que je reprends comme ceci pour un affichage minimum et cohérent avec la source
j'ai ajouté les bordures pour que tu puisse voir que les fusions sont gérées
toi qui aime le light ben tu es servi
la voici en noir et blanc style css minimum (necessaire!!!!!!)
la routine + l'appel
Sub envoie()
Dim Tabl, olApp As Object, olMail As Object, olMailItem, message$
'***********************************
'récupération du tableau en code html
Tabl = tableauhtml(Feuil1.[A1:F5])
'***********************************
Debug.Print Tabl
Set olApp = CreateObject("outlook.application")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.Subject = "Suivi de Stock quotidien"
.To = "adresse@mail.com"
'.CC = Range("L" & Ligne) 'ou .BCC pour Cci
message = "Chers collègues, <br/><br/> Veuillez trouver ci-dessous l'état des stocks du jour, le " _
& Date & ". <br/><br/>" & Tabl & "<br/><br/> Bonne fin de journée !"
.htmlbody = message
.Display
End With
End Sub
Function tableauhtml(plage As Range) As String
Dim tbl, Addr$
Dim i%, j%
tableauhtml = "<table>"
For i = 1 To plage.Row + plage.Rows.Count - 1
tableauhtml = tableauhtml & "<tr>"
For j = 1 To plage.Column + plage.Columns.Count - 1
Addr = plage.Cells(i, j).MergeArea.Address
colspan = " colspan=" & Range(Addr).Columns.Count 'fusion colonne html a l'identique de la cellule la plage
rowspan = " rowspan=" & Range(Addr).Rows.Count 'fusion ligne html a l'identique de la cellule la plage
styl = " style=""border:1px solid #000000; width:" & Round(Range(Addr).Width) & "pt;height:" & Round(Range(Addr).Height) & "pt;"""
If Not tableauhtml Like "*" & Addr & "*" Then tableauhtml = tableauhtml & "<td id=" & Addr & colspan & rowspan & styl & " >" & plage.Range(Addr)(1) & "</td>"
Next
tableauhtml = tableauhtml & "</tr>"
Next
tableauhtml = tableauhtml & "</table>"
End Functionle code html obtenu
<table><tr><td id=$A$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" >vvvd</td><td id=$B$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" ></td><td id=$C$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" ></td><td id=$D$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" ></td><td id=$E$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" ></td><td id=$F$1 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:15pt;" ></td></tr><tr><td id=$A$2:$A$4 colspan=1 rowspan=3 style="border:1px solid #000000; width:62pt;height:77pt;" ></td><td id=$B$2 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:14pt;" >zzzdz</td><td id=$C$2 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:14pt;" >zzdfz</td><td id=$D$2:$E$3 colspan=2 rowspan=2 style="border:1px solid #000000; width:125pt;height:30pt;" >dfdf</td><td
id=$F$2 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:14pt;" >dfdf</td></tr><tr><td id=$B$3 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:16pt;" >ddd</td><td id=$C$3 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:16pt;" ></td><td id=$F$3 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:16pt;" ></td></tr><tr><td id=$B$4 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:47pt;" ></td><td id=$C$4 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:47pt;" >aaaaaaaaaaaaaaaaaaaaaaa</td><td id=$D$4 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:47pt;" ></td><td id=$E$4 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:47pt;" ></td><td id=$F$4 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:47pt;" >sdfdf</td></tr><tr><td id=$A$5 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:24pt;" >
dd</td><td id=$B$5 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:24pt;" >dd</td><td id=$C$5:$D$5 colspan=2 rowspan=1 style="border:1px solid #000000; width:125pt;height:24pt;" >hgfgf</td><td id=$E$5 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:24pt;" ></td><td id=$F$5 colspan=1 rowspan=1 style="border:1px solid #000000; width:62pt;height:24pt;" >dfdfcd</td></tr></table>l'original excel
et le résultat
voila c'est du light mais avec un minimum de cohérence avec la source (tu les vois les fusions)
perso j'ajouterais le wraptext afin de garder celui ci dans le html la cellule le "AAAAA....." n'est pas
mais bon comme tu peux le voir avec ta routine de base(originale) tu étais loin d'obtenir une cohérence avec l'original (excel)
pour te la faire courte une table sans css(un minimum) pour ressembler (avec cohérence) a la source excel est quasiment impossible
cela dit a travailler en string comme ca on obtient un code à rallonge alors qu'en DOM ( comme mon exemple)ca ne nettoie toutes les chose inutiles
le leger c'est bien mais parfois faut ce qui faut
@Steelson pour information j'ai testé et cela fonctionne aussi mais la mise en forme aussi lié à ma dernière colonne de montant et si possible les lignes du tableau en question
pour garder la mise en forme
ben c'est simple
dans mon exemple tu remplace ceci
TD.innerhtml = "<Font>" & cel.Value & "</font>"
par cela
TD.innerhtml = "<Font>" & cel.Text & "</font>"
voili voilou c'est pas compliqué
et pour info travailler en string est beaucoup moins performant que travailler avec le DOM ca se voit largement sur de grande plage
conclusion :léger en terme de code ne veut pas dire plus performant
Patrick,
- je ne disconviens pas que ta solution est très bien
- n'oublie pas aussi le charset pour compléter ton projet, ou plutôt la prise en compte des caractères diacritiques s'il y en avait !
@Patrick merci pour ta ligne de correction cela fonctionne bien
par contre une question :
si je rajoute une nouvelle copie de plage:
Find_Nego = "Negociation"
Set cel_nego = .Columns("A").Find(Find_Nego)
If Not cel_nego Is Nothing Then
start_nego = cel_nego.Row
count_nego = cel_nego.MergeArea.Rows.Count
'MsgBox ("Start " & start_nego & " Count " & count_nego)
'***********************************
'récupération du tableau en code html
Tabl_nego = htmltable(.Range("A" & start_nego & ":I" & count_nego))
'***********************************
End Ifet que je l'affiche avec Tabl_Nego et bien ca reprend tant le tableau des actifs que de nego alors que la plage est bonne
d'autant que je devrais aussi rajouter d'autres tableaux apres...
@Darkangel
tu dois lancer autant de fois la fonction que de plage non contiguë et compiler
tu ne peux pas convertir en un coup quand c'est pas contiguë
@Steelson
a ta version remastérisée j'ai ajouté le wraptext
Function tableauhtml(plage As Range) As String
Dim tbl, Addr$
Dim i%, j%
tableauhtml = "<table>"
For i = 1 To plage.Row + plage.Rows.Count - 1
tableauhtml = tableauhtml & "<tr>"
For j = 1 To plage.Column + plage.Columns.Count - 1
Addr = plage.Cells(i, j).MergeArea.Address
If Range(Addr).Columns.Count > 1 Then colspan = " colspan=" & Range(Addr).Columns.Count Else colspan = "" 'fusion colonne html a l'identique de la cellule la plage
If Range(Addr).Rows.Count > 1 Then rowspan = " rowspan=" & Range(Addr).Rows.Count Else rowspan = "" 'fusion ligne html a l'identique de la cellule la plage
styl = " style=""margin:2pt;border:1px solid #000000; width:" & Round(Range(Addr).Width) & "pt;height:" & Round(Range(Addr).Height) & "pt;"
If Range(Addr).WrapText Then styl = styl & " WORD-BREAK: break-all;"
styl = styl & """"
If Not tableauhtml Like "*" & Addr & "*" Then tableauhtml = tableauhtml & "<td id=" & Addr & colspan & rowspan & styl & " >" & Range(Addr)(1).Text & "</td>"
Next
tableauhtml = tableauhtml & "</tr>"
Next
tableauhtml = tableauhtml & "</table>"
End Functionoriginal
résultat
voila un minimum de cohérence avec l'original
après aller plus loin en string ça vaut pas le coup
ton zip testé voila ce que j'obtiens
ma fois mon code fonctionne très bien
si ça n'est pas cela que tu souhaite obtenir il faut être plus clair
merci patrick
Votre code fonctionne en effet, c'est peut être moi qui en fait mauvais usage
je voudrais pour le points des projets actifs la liste de tous les projets actifs uniquement
pour le point sur les projets en négoci juste les projets en négociations et pas les actifs avec
ps: je m'etais deja gouré sur un autre point mais en résulte le meme soucis
count_final = start_nego + count_nego -1
'***********************************
'récupération du tableau en code html
nego = htmltable(.Range("A" & start_nego & ":I" & count_final))
j'ai ajoute encore un autre tableau et en fait ca commence au bon endroit mais rajoute les lignes en dessous également
Ainsi de suite
merci par avance
re
oui en effet il y a un effet de dédoublonnage(jumelage) de tableau
un name ne correspondrait pas a plusieurs de ces tableaux ou l'intersect de plusieurs d'entre eux par hasard ???????
en tout cas c'est bizarre effectivement
j'ai pourtant décanté et modifier ton code j'avoue être perplexe
non chaque tableau est indépendant et non nommé (c'est fichier indépendant et généré par ma base de donnée)
je reprends juste le traitement depuis le fichier exporte car reprends les memes données
oui ben quand on le scrute en xml en l'ouvrant avec winrar(car j'avais un doute) c'est un vrai boxon ce fichier
ben mon amis tu n'es pas sorti de l'auberge
et puis si!!! tu a 2 name qui sont transformés en #ref!
ce qui fait que ca ne correspond plus aux plages mais l'association est toujours valide dans la feuille en xml
ouvre le avec winrar tu verra
le voilà ton problème
autrement dit je vais devoir repartir de la base de donnée elle meme :)
je confirme
je viens d'insérer une ligne supplémentaire entre chaque tableaux et résultat ça double pas CA TRIPLE !!!!!
et comme ca decale le ligne maintenant je prend toute la feuille
fout moi ce fichier a la poubelle
pourtant regarde les plage sont correctement identifiées
j'ai trouvé le code qui génère le fichier rapport, celui ci avant été fait par quelqu'un du forum... qui avait bien voulu m'aider
mais alors de la à savoir ou cela bug...
Public Sub Reports()
Dim tb_projects As ListObject
Dim dic_statuts As Object, dic_projects As Object
Dim i As Integer
Dim PI_interne As String, Acronym As String, Topic As String, début As Variant, fin As Variant, commentaire As String, statut As String, chemin As String, fichier As String
Dim Investigator_firstname As String, Investigator_name As String, Budget_Requested As Currency
Dim id_projet As Variant, clé As Variant, Cancel As Boolean, iRow2 As Integer, sData As String, X As Integer, iRow1 As Integer, destination As String, S As String, Rep As String, Nom As String
Dim wb As Workbook
Dim project_Range As Variant
Set dic_statuts = CreateObject("Scripting.Dictionary")
Set tb_projects = [Temp].ListObject
With tb_projects
For i = 0 To .ListRows.Count
id_projet = .ListColumns("Id_Project").DataBodyRange.Rows(i)
Acronym = .ListColumns("Acronym").DataBodyRange.Rows(i)
Topic = .ListColumns("Topic").DataBodyRange.Rows(i)
début = .ListColumns("Start_Date").DataBodyRange.Rows(i)
fin = .ListColumns("End_Date").DataBodyRange.Rows(i)
commentaire = .ListColumns("Comments").DataBodyRange.Rows(i)
statut = .ListColumns("Status").DataBodyRange.Rows(i)
With Worksheets("Investigators")
On Error Resume Next
project_Range = Application.Match(id_projet, .Range("B:B"), 0)
Investigator_firstname = Empty: Investigator_name = Empty
If Err = 0 Then
Investigator_firstname = .Range("A:G")(project_Range, 3)
Investigator_name = .Range("A:G")(project_Range, 4)
End If
End With
With Worksheets("Budget")
On Error Resume Next
project_Range = Application.Match(id_projet, .Range("A:A"), 0)
Budget_Requested = Empty
If Err = 0 Then
Budget_Requested = .Range("A:O")(project_Range, 15)
End If
End With
'And statut <> "Rejected" And statut <> "Abandonned"
If statut <> "Closed" Then
If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
Set dic_projects = dic_statuts(statut)
dic_projects(id_projet) = Array(statut, Acronym, Topic, début, fin, commentaire, Investigator_firstname, Investigator_name, CLng(Budget_Requested))
Set dic_statuts(statut) = dic_projects
End If
Next i
End With
chemin = ThisWorkbook.Path & "/"
fichier = "rapport.xlsm"
'Empêche le rafraichissement de l'écran
Application.ScreenUpdating = False
'Ouverture du fichier
Set wb = Workbooks.Open(chemin & fichier)
Application.DisplayAlerts = False
wb.Worksheets("Rapport").Delete
wb.Sheets.Add.Name = "Rapport"
'on ecrit dans le fichier
With wb.Sheets("Rapport")
.Range("A1:I1").Merge
.Rows(1).Font.Bold = True
.Rows(1).Font.Size = 14
.Range("A1").HorizontalAlignment = xlCenterAcrossSelection
.Range("A1") = "Rapport projets au " & Format(Date, "dd-mm-yyyy")
ActiveWindow.DisplayGridlines = False
i = 0
For Each clé In dic_statuts
Set dic_projects = dic_statuts(clé)
.Range("A4").Offset(i).Resize(dic_projects.Count, 9) = Application.Transpose(Application.Transpose(dic_projects.Items))
i = i + dic_projects.Count
Next clé
End With
' Rows(4).HorizontalAlignment = xlCenter
' Columns("I").NumberFormat = " 0.00 €"
Cancel = True
iRow2 = Range("A" & Rows.Count).End(xlUp).Rowa
sData = Range("A" & iRow2).Value
Application.DisplayAlerts = False
For X = Range("A" & Rows.Count).End(xlUp).row To 1 Step -1
If Range("A" & X).Value <> sData Then
iRow1 = X + 1
Range("A" & iRow1 & ":I" & iRow2).BorderAround Weight:=xlMedium
Range("A" & iRow1 & ":A" & iRow2).Merge
Range("A" & iRow1 & ":A" & iRow2).VerticalAlignment = xlVAlignCenter
Range("A" & iRow1 & ":A" & iRow2).HorizontalAlignment = xlHAlignCenter
sData = Range("A" & X).Value
iRow2 = X
If Range("A" & X) <> "Status" Then
Rows(iRow1).Insert Shift:=xlDown
Else
Range("A" & X & ":I" & X).Borders.Weight = xlMedium
Range("A" & X & ":I" & X).HorizontalAlignment = xlHAlignCenter
Range("A" & X & ":I" & X).Font.Bold = True
Exit For
End If
End If
Next
Columns("I:I").NumberFormat = "#,##0.00 €"
Application.DisplayAlerts = False
Columns("A:I").AutoFit
Columns("B:B").VerticalAlignment = xlVAlignCenter
Columns("C:C").ColumnWidth = "35"
Columns("C:C").WrapText = False
Columns("F:F").ColumnWidth = "45"
'pour fermer le classeur que tu viens d'ouvrir et l'enregistrer
wb.Close True
Worksheets("Temp").Delete
End Subau passage
@Steelson
Patrick,
je ne disconviens pas que ta solution est très bien
n'oublie pas aussi le charset pour compléter ton projet, ou plutôt la prise en compte des caractères diacritiques s'il y en avait !
pas besoins outlook converti tout avec son propre "mime"
avec cdo ou pour export en html oui par contre
a ben cherche pas c'est exporté d'un listobject
les voila les #ref! en pagaille que j'ai trouvé dans le xml
bah du coup je ne sais plus du tout comment procéder