Copier range et coller dans mail
re
je soupconne cette ligne deja
Application.Transpose(Application.Transpose(dic_projects.Items))
comme c'est un TS meme si tu sépare avec une insertion de ligne le tableau comprend tout
je serait toi je travaillerais directement avec la base
ok je vais tenter depuis la base elle meme
mais le soucis c'est que je dois partir de mon onglet projet entier, lancer via une liste de triage dans un fichier temp (ca je sais faire) afin d'avoir les projets dans l'ordre de statut mais une fois cela fait :
je dois pouvoir virer les colonnes ne me servant pas..
Aller chercher dans les différents autres onglets toutes les informations requises par projet et les incorproerr dans ce meme temp pour ensuite etre mis dans un fichier et dans le mail..
Aussi comment procéder le plus simplement possible?
Voilà ce que j'obtiens brut de forge ... il y a des doublons ? des triplets ? sans rien modifier du fichier rapport, il est ce qu'il est et il reste ce qu'il est. Et pour le moment je n'ai rien touché à ton module de base.
C’est effectivement ce que j´ai besoin de générer
Donc c'est simple ... rien d'autre ? des formats, des bordures ? il y aura des sesterces en euro ? où ? quelles colonnes ?
Pour le format, faut-il reprendre celui du fichier rapports ?
Fonction de ta réponse, je t'envoie le complément par rapport à ton code que je ne retoucherai pas, il fait le job.
Je ne suis plus devant mon ordi mais c’est la dernière colonne qui doit être en euro
Si on peut garder les bordures c’est mieux mais effectivement j’aimerais avoir la liste des projets actifs sous actif et ainsi de suite pour chaque catégorie
merci à vous en tout cas
quel code tu utilise Steelson que l'on parte sur la même base
voila j'ai tout passé en revu et j'avais omis plusieurs choses (c'est de ma faute)
donc voila le code du thisworkbook(oui j'ai fait un peu le ménage )
Private Sub envoi_mail()
Dim Ol As New Outlook.Application, Olmail As MailItem, RnGnego As Range, project_Active As Range, cel As Range, tabl, Tabl_nego
chemin = ThisWorkbook.Path & "/"
fichier = "rapport.xlsm"
Application.ScreenUpdating = False
Set wb = Workbooks.Open(chemin & fichier)
Application.DisplayAlerts = False
With wb.Sheets("Rapport")
'**************************************************
Set cel = .Columns("A").Find("Active", , xlValues)
If Not cel Is Nothing Then
Set project_Active = cel.MergeArea.Resize(, 9)
count_active = project_Active.Rows.Count
tabl = htmltable(project_Active) 'récupération du tableau en code html
End If
'**************************************************
Set cel = .Columns("A").Find("Negociation", , xlValues)
If Not cel Is Nothing Then
count_nego = cel.MergeArea.Rows.Count
Set RnGnego = cel.MergeArea.Resize(, 9)
Tabl_nego = htmltable(RnGnego) 'récupération du tableau en code html
End If
'**************************************************
End With
wb.Close
'********************************************outlook*****************************
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = "me@gmail.com"
.CC = ""
.Subject = "Suivi activité"
'.Attachments.Add (chemin & fichier)
Message = "Chers collègues, <br/><br/> Veuillez trouver ci-dessous l'état des stocks du jour, le " & Date & ". <br/><br/>" & _
"2) Liste des projets actifs (" & count_active & " au total)<br>" & tabl & "<br/>" & _
"3) Lite des projets en négociation (" & count_nego & " au total)<br>" & Tabl_nego & _
"<br>Cordialement"
.HTMLBody = Message
'.send
.display
End With
End Subet maintenant mes fonction dans le module
Option Explicit
Function htmltable(plage As Range)
Dim Doc As Object, TBODY, Table, TR, TD, Bord, Lig&, col&, cel As Range, Ta, Tal, Va, Vral
Set Doc = CreateObject("htmlfile")
Doc.Body.innerhtml = "<table><tbody></table></tbody>"
Set Table = Doc.getelementsbytagname("TABLE")(0)
With Table.Style
.Bordercollapse = "collapse": .FontSize = "11pt": .fontfamily = "calibri"
End With
Set TBODY = Doc.getelementsbytagname("TBODY")(0)
For Lig = 1 To plage.Rows.Count
Set TR = Doc.createelement("TR")
TBODY.appendchild (TR)
For col = 1 To plage.Columns.Count
Set cel = plage.Cells(Lig, col)
If Doc.getelementbyid(cel.MergeArea.Address) Is Nothing Then
Set TD = Doc.createelement("TD")
TD.ID = cel.MergeArea.Address
TD.rowspan = cel.MergeArea.Rows.Count: TD.colspan = cel.MergeArea.Columns.Count
TD.Style.Width = Round(cel.MergeArea.Width) & "pt"
TD.Style.Height = Round(cel.MergeArea.Height) & "pt"
'TD.innerhtml = "<Font>" & cel.Value & "</font>"
TD.innerhtml = "<Font>" & cel.Text & "</font>"
TD.Style.Border = "1px solid black"
If cel(1).WrapText = True Then TD.Style.wordBreak = "break-all" 'applique le wraptext de la cellule
TD.Style.margin = "1pt" 'applique la marge de excel
'******************************************************************************************************************************
'option Bloquer ces lignes ci dessous et vous avez votre tableau en noir et blanc(commentaire
If Not IsNull(cel.Font.Color) And cel.Font.Color <> vbBlack Then TD.Style.Color = coul_XL_to_coul_HTMLX(cel.Cells(1).Font.Color)
If Not IsNull(cel.Font.Name) Then TD.Style.fontfamily = cel.Font.Name 'applique le font name de la cellule
TD.Style.backgroundcolor = coul_XL_to_coul_HTMLX(cel.Interior.Color) 'applique la couleur de fond de la cellule
Bord = bordureTD(cel.MergeArea) 'appel fonction recupe le style de bordure en html
TD.Style.BorderStyle = Bord(0) 'applique le border style
TD.Style.borderwidth = Bord(1) 'applique le borderweight
TD.Style.BorderColor = Bord(2) 'applique le bordercolor
'alignement(commentaire)
Ta = cel.HorizontalAlignment: Tal = Switch(Ta = xlLeft, "left", Ta = xlCenter, "center", Ta = xlRight, "right", Ta = xlGeneral, "left", IsDate(cel.Value) And Ta = xlGeneral, "right")
Va = cel.VerticalAlignment: Vral = Switch(Va = xlTop, "top", Va = xlCenter, "middle", Va = xlBottom, "bottom", Va = xlGeneral, "bottom")
If IsDate(cel.Value) And Ta = xlGeneral Then Tal = "right"
TD.Style.TextAlign = Tal
TD.Style.verticalalign = Vral
'******************************************************************************************************************************
TR.appendchild (TD)
End If
Next
Next
htmltable = Table.outerhtml
End Function
Function bordureTD(cel)
'top right bottom left
Dim tabl(3), BDTW, BDRW, BDBW, BDLW, BDTC, BDRC, BDBC, BDLC, bordurestyle, bordureweight, BorderColor
With cel
BDTW = IIf(.Borders(xlEdgeTop).LineStyle = xlNone, "1", .Borders(xlEdgeTop).Weight)
BDRW = IIf(.Borders(xlEdgeRight).LineStyle = xlNone, "1", .Borders(xlEdgeRight).Weight)
BDBW = IIf(.Borders(xlEdgeBottom).LineStyle = xlNone, "1", .Borders(xlEdgeBottom).Weight)
BDLW = IIf(.Borders(xlEdgeLeft).LineStyle = xlNone, "1", .Borders(xlEdgeLeft).Weight)
BDTC = IIf(.Borders(xlEdgeTop).LineStyle = xlNone, "#E6E6E6", coul_XL_to_coul_HTMLX(.Borders(xlEdgeTop).Color))
BDRC = IIf(.Borders(xlEdgeRight).LineStyle = xlNone, "#E6E6E6", coul_XL_to_coul_HTMLX(.Borders(xlEdgeRight).Color))
BDBC = IIf(.Borders(xlEdgeBottom).LineStyle = xlNone, "#E6E6E6", coul_XL_to_coul_HTMLX(.Borders(xlEdgeBottom).Color))
BDLC = IIf(.Borders(xlEdgeLeft).LineStyle = xlNone, "#E6E6E6", coul_XL_to_coul_HTMLX(.Borders(xlEdgeLeft).Color))
bordurestyle = .Borders(xlEdgeTop).LineStyle & " " & .Borders(xlEdgeRight).LineStyle & " " & .Borders(xlEdgeBottom).LineStyle & " " & .Borders(xlEdgeLeft).LineStyle
bordurestyle = Replace(Replace(Replace(Replace(Replace(Replace(bordurestyle, -4118, "dotted"), "-4119", "double"), "-4115", "dashed"), "-4142", "solid"), "1", "solid"), "4", "dashed")
bordureweight = BDTW & " " & BDRW & " " & BDBW & " " & BDLW
BorderColor = BDTC & " " & BDRC & " " & BDBC & " " & BDLC
bordureweight = Replace(Replace(Replace(Replace(Replace(bordureweight, "-4138", "2px "), 4, "3px "), 1, "1px "), 2, "2px "), " px", "")
End With
tabl(0) = bordurestyle
tabl(1) = bordureweight
tabl(2) = BorderColor
bordureTD = tabl
End Function
Function coul_XL_to_coul_HTMLX(couleur)
Dim str0 As String, strf As String
str0 = Right("000000" & Hex(couleur), 6): strf = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
coul_XL_to_coul_HTMLX = "#" & strf & ""
End Functionle résultat
Fabuleux Patrick,
d'un seul coup, plus de problème de #ref!, de listobjects, de name, de code en amont et de double transpose ...
quel code tu utilise Steelson que l'on parte sur la même base
on s'en fout ! on parle du résultat, mais pour ce qui est de ma prose, le code fait une petite dizaine de lignes
comme dit Montesquieu (Charles Louis de Secondat, baron de La Brède et de Montesquieu) :
"Le mieux est le mortel ennemi du bien"
(souvent mal retranscrit)
voila j'ai tout passé en revu et j'avais omis plusieurs choses (c'est de ma faute)
Message = "Chers collègues, <br/><br/> Veuillez trouver ci-dessous l'état des stocks du jour, le " & Date & ". <br/><br/>" & _ "2) Liste des projets actifs (" & count_active & " au total)<br>" & tabl & "<br/>" & _ "3) Lite des projets en négociation (" & count_nego & " au total)<br>" & Tabl_nego & _ "<br>Cordialement" .HTMLBody = Message
juste un conseil amical constructif, mets ceci pour avoir aussi ta propre signature outlook dans le mail
.HTMLBody = Message & .HTMLBodyL'objectif étant atteint, je ne vais pas me casser la tête et je vais m'occuper d'autres sujets ! Content juste d'avoir débloqué les choses.
re
bonjour Steelson si c'est important j'aimerais bien connaitre ton fabuleux code de 10 ligne qui gère les fusions
pour info voici un fichier test avec mes 3 versions: les 3 font le job et présentent des tableaux dignes de ce nom
version dom complète
version dom simple
version string
et pour la signature moi je ne m'en sert pas j’insère une image d’Entête (banderole en haut ou en bas ) dans mes message j'ai gardé ce principe car perso j'utilise plutôt CDO
Merci patrick, je vais désormais pouvoir voir comment le code fonctionne sachant que celui me donne le résultat escompté
grand merci à vous à votre assistance
est il toutefois possible de jouer sur la largeur des colonnes ? exemple la plus à droite donnant les budgets se met en retour à la ligne dès que ca dépasse le million..
@ DarkAngel ... même si Patrick n'est pas intéressé pour lui, comme tu utilises outlook
mets ceci pour avoir aussi ta propre signature outlook dans le mail
.HTMLBody = Message & .HTMLBody
@ Patrick,
si c'est important j'aimerais bien connaitre ton fabuleux code de 10 ligne qui gère les fusions
j'ai aussi une version en 2 lignes si tu veux critiquer (positivement bien sûr)
Cells.Copy
' ...
SendKeys "^v", Trueou en une petite dizaine, avec de belles grosses bordures que je n'aime pas pour bien mettre en valeur
edit : code amélioré voir ci-dessouset samsuffit, expérience de 40 années industrielles où l'efficacité primait.
Voilà la dizaine de lignes de code ...
et avec nowrap comme demandé par DarkAngel
Merci patrick, ... les budgets se met en retour à la ligne dès que ca dépasse le million..
Function tableHTML(rng As Range)
Dim i%, j%, nbrow%, nbcol%
tableHTML = "<table style=""white-space: nowrap; border: 1px solid black; border-collapse: collapse;"" >"
For i = 1 To rng.Rows.Count
tableHTML = tableHTML & "<tr>"
For j = 1 To rng.Columns.Count
If InStr(rng.Cells(i, j).MergeArea.Address, ":") > 0 Then
nbrow = rng.Cells(i, j).MergeArea.Rows.Count: nbcol = rng.Cells(i, j).MergeArea.Columns.Count
If rng.Cells(i, j).Address = Split(rng.Cells(i, j).MergeArea.Address, ":")(0) Then tableHTML = tableHTML & "<td " & IIf(nbcol > 1, "colspan=" & nbcol, "") & " " & IIf(nbrow > 1, "rowspan=" & nbrow, "") & " style=""border: 1px solid black; padding: 4px;"" >" & rng.Cells(i, j).Text & "</td>"
Else
tableHTML = tableHTML & "<td style=""border: 1px solid black; padding: 4px;"" >" & rng.Cells(i, j).Text & "</td>"
End If
Next
tableHTML = tableHTML & "</tr>"
Next
tableHTML = tableHTML & "</table>"
End Functionbonsoir
@Steelson c'est ni plus ni moins que ce que je fait en string test d'existence est différent c'est tout les attributs css un peu différents
par contre les cellules (td) ne sont pas dimensionnées
@Darkangel mes 3 modèles reprennent la valeur en string et les largeurs sont sensées être identiques il est donc impossible que ta chaîne se mette en wrap dans les cellules html si elles ne le sont pas dans la feuille excel sauf modifs ultérieures
par contre les cellules (td) ne sont pas dimensionnées
et c'est tout à fait volontaire, le tableau s'adapte
à lire sur l'usage de pt et de px en css
re
bonjour Steelson on est sur une table basique c'est pas vraiment nécessaire de convertir en le point en px
mais si tu y tiens dans ma fonction rangetohtml j'ai cette chose sans api
teste ça
Function P_ToPx()
With ActiveWindow.ActivePane
P_ToPx = (.PointsToScreenPixelsY(72) - .PointsToScreenPixelsY(0)) / 72
End With
end function
sub test()
msgbox [A1].width*P_ToPx
End subet oui car le coeff peut changer en fonction du dpi que tu utilise
par exemple moi je suis en DPI 120 sur mon grand écran donc 1 point =1.6666666667 pixel
tandis que sur mon ecran pc je suis en 96 donc (100) et donc 1 point = 1.333333333333333 pixel
enjoy :)
va faire un tour sur DVP
aujourd’hui j'arrive a te rendre une table quasiment identique à la source excel suf quelque détails du genre dashdotted qui n'existe pas en html et que je transforme en dotted 1px de large en plus et quelque fontfamiliy qui ne sont pas pris en charge en html
Ce n'est pas nouveau, on a déjà rencontré ici des écarts entre excel par exemple et une sortie pdf, écarts qui varient d'un utilisateur à l'autre, d'un écran à l'autre. Je reste simple, je laisse le tableau se dimensionner seul. L'essentiel, ce sont les infos et le résultat, pas la forme.
Tu ne peux pas non plus nier les faits ...
il est donc impossible que ...
Maintenant, le client attend une solution, pas des cogitations.
oui justement une table non dimensionnée selon l'écran et l'application mail du destinataire la table sera transformée et peut être même illisible
après vous faite comme vous voulez
la c'est simple c'est lineaire mais dans d'autres cas il peut y avoir plusieurs lignes dans une cellules par le wrap ou des chr(10) et autres cochonneries
j'ai donné une solution universelle qui fonctionne avec une table simple ou plus complexe en terme de format
libre a vous de l'utiliser ou pas
perso un html je le travaillerais toujours en DOM c'est un minimum quand on veut faire du bon job
si tu préfère prendre un tournevis au lieu d'un ciseau a bois pour pour lamer un morceau de bois libre a toi mais ne prétend pas que c'est la meilleure solution
travailler en string est une des plus lourde charge en vba (je vais pas te l'apprendre) ça n'est d'ailleurs pas conseillé quand on peut s'en passer
quand a la cogitation tu devrais au contraire y penser ,c'est toujours mieux en développement vba ou autres d'applicatif
vous avez des outils servez vous en
Ce que je vois, c'est qu'un thème qui aurait dû être soldé en moins d'une page de fil de discussion est encore ouvert à la fin de la 3ème page !