Problème suite à un passage en office 2016
Bonjour à tous,
Je m'adresse à vous pour un souci concernant une ligne de code VBA qui jusqu'à présent marche très bien sur office 2010.
Seulement, notre service informatique commence à passer de plus en plus de poste sur office 2016.
Du coup, cette fameuse ligne de code est la suivante :
ActiveWorkbook.SendMail Recipients:="xxxxxxxxxx.fct@xxxxxxxxx.fr", Subject:="Preuve de mutation - " & Range("V2").Value & " - " & Format(Date, "dd/mm/yy") & " - " & Format(Time, "hh") & "h" & Format(Time, "mm")
Le résultat de cette formule est simplement de placer comme objet dans le mail : "Preuve de mutation - Mr Dupont - 28/02/2018 - 14h30"
Cela permet au service recevant le mail de traiter plus facilement le document.
Seul hic... Sous office 2016, l'objet du mail ne fait plus du tout apparaitre un objet comme cité ci-dessus mais des symboles chinois (ou quelque chose s'en rapprochant fortement).
Si quelqu'un peut me proposer quelque chose de plus simple qui serait compatible pour les deux versions ou encore une version 2016 (auquel cas je créerai un autre bouton avec "OFFICE 2016" et renommer l'autre "OFFICE 2010", je m'en contenterai très largement
En attendant d'éventuelles réponses et en vous remerciant par avance
Bonjour,
avez-vous le même résultat si vous faite le test suivant:
Sub test()
MsgBox "Preuve de mutation - " & Range("V2").Value & " - " & Format(Date, "dd/mm/yy") & " - " & Format(Time, "hh") & "h" & Format(Time, "mm")
End Sub
Bonsoir,
Malheureusement, je ne pourrai pas tester cela avant lundi soir, mais votre proposition ne va-t-elle pas tout simplement afficher un message à l'ouverture du fichier ?
Si c'est cela, ça ne me serait malheureusement pas utile car les utilisateurs auront toutes une série de mail en pagaille et le but sera d'ouvrir rapidement du premier coup le bon fichier sans avoir à ouvrir les autres.
Malheureusement, je ne pourrai pas tester cela avant lundi soir, mais votre proposition ne va-t-elle pas tout simplement afficher un message à l'ouverture du fichier ?
non il faut exécuter la macro en pas à pas ou via le Menu, Développeur, Macro.
c'est pour voir si votre application va planter en exécutant cette simple macro.
Comme expliqué ci-dessus, je ne pourrai être en mesure que de l'essayer lundi au boulot ^^.
Mais en ayant essayer sur la version 2016 chez moi, j'ai bien le résultat attendu, une msgbox faisant apparaitre le texte voulu.
Ceci-dit, le code est le même que la première version que j'avais proposé j'ai l'impression et le problème survient uniquement après l'envoi du mail avec le fichier en pièce jointe que j'envoie.
Mais je ferai un copier coller dans la macro en question du morceau de code qui m'intéresserait
Je vous tiens au courant dès que celle-ci aura été testée
Merci pour ce retour, au plaisir!
si le problème est résolu, s.v.p. pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!
Bonjour,
Après vérification malheureusement, le résultat ressort bien comme attendu en office 2016 à l'affichage.
Il existe donc un souci sur une autre partie de macro que je vous fais parvenir ultérieurement.
Cordialement
Après avoir retenté plusieurs choses, je retombe toujours sur le même résultat, aussi je colle l'intégralité de la manip (rien de sorcier, juste du copier coller et un envoi)
Sub colofficier()
'
' Vision conseillers
'
'
Application.ScreenUpdating = False
Columns("I:I").Select
Selection.EntireColumn.Hidden = True
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Columns("O:O").Select
Selection.EntireColumn.Hidden = True
Columns("T:U").Select
Selection.EntireColumn.Hidden = True
Columns("Z:Z").Select
Selection.EntireColumn.Hidden = True
Columns("AB:AB").Select
Selection.EntireColumn.Hidden = True
Columns("AO:AO").Select
Selection.EntireColumn.Hidden = True
Columns("AI:AI").Select
Selection.EntireColumn.Hidden = True
Columns("AR:AR").Select
Selection.EntireColumn.Hidden = True
Columns("BH:CG").Select
Selection.EntireColumn.Hidden = True
End Sub
Sub coltotal()
'
' Vision totale
'
'
Application.ScreenUpdating = False
Cells.Select
Selection.EntireColumn.Hidden = False
Range("A2").Select
End Sub
Sub envoiepmlight()
'
' copier coller sur PM deux onglets pour conseillers et MVT - principe de suppression de colonne à la place de les masquer car bug
'
'
Application.ScreenUpdating = False
ChDir "X:\XXX\XXXX\XXXXXXX\XXXXxxxxx"
Workbooks.Open Filename:="X:\XXX\XXXX\XXXXXXX\XXXXxxxxxx"
Windows("SOCLE GLOBAL.xlsb").Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Range("D3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("PM.xlsb").Activate
Sheets("Conseiller").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Conseiller").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Conseiller").Sort.SortFields.Add Key:=Range( _
"AV2:AV4"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"GAA,GCAA,CRGCAA,CREGDA,GDA,CREGBA,GBA,CMUSCE,COL,CCL,LCL,CMUSHC,CLC,LCL,CDT,CCD,CNE,CMUS1,CCN,LTN,CMUS2,CLT,CSL,SLT,ASP,CASP,EOF,MAJ,ADC,ACH,SCMUS1,ADJ,INF.CN,SCH,SGT,CCH,CCH1,CAL,AV1,1CL,AV,SDT,ELEVCPA" _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Conseiller").Sort.SortFields.Add Key:=Range( _
"AW2:AW4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Conseiller").Sort.SortFields.Add Key:=Range( _
"AX2:AX4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Conseiller").Sort
.SetRange Range("A1:CD4")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:B").Select
Selection.Copy
Sheets("MVT").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("C1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("D1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("E1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("X:X").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("F1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("M:M").Select
Application.CutCopyMode = False
Selection.Copy
Range("H14").Select
Sheets("MVT").Select
Range("G1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("S:S").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("H1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("T:T").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Columns("I:I").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("J1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("AS:BD").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MVT").Select
Range("K1").Select
ActiveSheet.Paste
Sheets("Conseiller").Select
Columns("BE:BE").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("AF:AR").Select
Range("AR1").Activate
Selection.Delete Shift:=xlToLeft
Columns("Y:Y").Select
Columns("Y:Y").Select
Selection.Delete Shift:=xlToLeft
Columns("Q:R").Select
Range("R1").Activate
Selection.Delete Shift:=xlToLeft
Columns("K:L").Select
Range("L1").Activate
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("R:R").Select
Selection.Delete Shift:=xlToLeft
Sheets("MVT").Select
ActiveWorkbook.Save
ActiveWorkbook.SendMail Recipients:="drhaa-bgc.mvts.fct@intradef.gouv.fr", Subject:="Preuve de mutation - " & Range("V2").Value & " - " & Format(Date, "dd/mm/yy") & " - " & Format(Time, "hh") & "h" & Format(Time, "mm")
Sheets("Conseiller").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("MVT").Select
Cells.Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.Save
ActiveWindow.Close
'message de fermeture
MsgBox (" La preuve de mutation a bien été transmise à MOUVEMENT. ## En cas de nouvelle PM, pensez à fermer le socle puis le réouvrir. ##")
End Sub
Merci d'avance pour d'éventuelles aides.