Sauvegarder image userform

Version imprimable

Voir 40 message(s) de cette discussion en une page

19/10/2017, 14h36
Denis_67

Bon petite correction, le blanc comme couleur de fond ça fonctionne !!

Ces deux points sont des questions, pas des "obligations".
J'ai essayé de mettre une bordure, par contre celle ci n'est pas prise en compte.
Lorsqu'on a généré l'HTML, celui ci est modifiable dans IE peut on imaginer de le bloquer ?

Denis
19/10/2017, 14h43
patricktoulon

re

oui on peut rendre les input text non éditable bien sur
19/10/2017, 15h24
patricktoulon

1 pièce(s) jointe(s)

re

bon voila un exemplaire avec le mode en fonction
enlève exit sub dans la fonction mail Outlook
arrange le reste du code a ta convenance et enlevé les 4 lignes d'affichage dans IE dans la sub mail qui ne serviront plus a rien
par contre mon code dans le module2 tu n'y touche pas

teste et tu verra
19/10/2017, 17h42
Denis_67

1 pièce(s) jointe(s)

Patrick, voici un nouveau casse tete.

Autant la version d'encoi d'un tableau donnait la même image dans IE et dans Outlook, autant là ça coince dans Outlook.
J'ai fait une copie décran avec les trois stades le USF, le Tableau HTML dans IE, puis dans Outlook.

Pièce jointe 320867

Je ne suis pas trop cool de t'entrainer dans cette aventure !
Denis
19/10/2017, 18h24
patricktoulon

re

comme je te l'ai dis outlook moi c'est nada
de ce coté la il faut demander a dysorthographie et autres crack avec Outlook qui sont nombreux sur le forum

utilise tu un proxi au boulot sans doute oui ?
19/10/2017, 20h05
Denis_67

Le proxi ne doit pas être en cause, c'est le message brut qui est créé avant envoi qui est comme cela.
Tu me conseille d'ouvrir un nouveau sujet avec notre fichier en exemple, ou d'écrire à dysorthographie directement ?

Quand tu dit qu'on peu figer les listbox, j'ai essayé le lock à True dans l'USF, ça marche, mais le tableau généré dans IE lui est modifiable (et ça me parait logique d'ailleurs).

Denis
19/10/2017, 21h11
patricktoulon

puré
c'est pas vrai je t'ai dis de ne pas toucher mon module tu bloque rien modifie rien le blocage en écriture est déjà fait
mon module tu n'y touche pas pas pas pas pas !!!!!!!!!!!!
c'est clair comme ca ?
20/10/2017, 08h15
Denis_67

Petit malentendu Patrick, je n'ai pas touché le module.
J'avais mis pour tester la propriété d'un champ listbox dans le USF directement pour voir l'influence.
Puis je suis sortis de mon test sans sauvegarder cet essai.
De toute façon c'est pas le sujet principal.
Tout ce que tu as fait est bien et je ne veux pas y toucher.
Reste à voir si on peut envoyer le résultat dans Outlook.

Désolé de t'avoir donné ce coup de chaud !
Denis
20/10/2017, 12h17
patricktoulon

re

je viens de tester et effectivement dans le mail c'est mis en desordre
il semblerait qu'il n'y ai pas de solution
est ce que le tableau en piece jointe suffirait ou faut il vraiment qu'il soit dans le corps ???
20/10/2017, 12h32
Denis_67

Merci Patrick pour ton retour.

Alors oui la demande est bien d'avoir les données qui s'affichent dans le corps du message.

Si on ne peut résoudre cette compatibilité avec outlook , l'autre alternative serait et c'est un peu le retour au tout début de ma demande
de capturer une image de l'USF et l'envoyer.
Mais je ne sait pas s'il elle peut etre affichée par défaut et pas la aussi comme une piece jointe.

Enfin la dernière possibilité alimenter un masque à partir du USF et ensuite enoyer le tableau avec ta solution puisque j'ai testé et ça ca marche dans outlook.

Tu as vu aussi ma question en MP sur les listbox ?

Merci en tout cas pour tout ce que tu as déjà fait jusque là.
Denis

1 pièce(s) jointe(s)

pour l'image de la capture dans le corps du mail avec CDO je n'ai aucun souci mais avec Outlook il y a moulte exemple mais je n'ai jamais pu les tester

ci joint un exemple avec CDO
alors cdo avec un proxi ca peut etre un peu complexe mais avec le serveur smtp du fournisseur d'accès ca match nickel
si ca te convient comme ca on appellera a la rescousse d'autre crack de Outlook pour faire la même chose
clique sur le bouton 1
tu n'a qu'a modifier cela a ton cas dans le code sauf le lien de l'image il est identique dans toute les conditions
Code:

1 2 3 4 5 6 7 strSMTP = "smtp.free.fr" ' serveur sortant de la FAI emetteur = "chacha@hotmail.fr" ' emetteur destinataire = "toto@hotmail.fr" 'destinataires image = "C:\Users\" & Environ("username") & "\Desktop\imagetemp.jpg" 'lien de l'image titre = "mail urgent" smessage = "voici le tableau <br> " ' message SendMail emetteur, destinataire, titre, smessage, image, strSMTP

20/10/2017, 14h50
Denis_67

Désolé, mais comme je l'avais dit au début, le problème c'est que le snapshot va activer l'utilitaire de capture installé par défaut chez les utilisateurs à dans notre cas Greenshot.
Il me faudrait modifier tous les postes pour changer le capture region.
Je l'ai fait pour tester sur mon poste, mais
ici

Code:

Set Shap = ActiveSheet.Shapes(ShapeCount)

J'ai une erreur
l'index de cette collection dépasse les limite.
Denis
20/10/2017, 15h07
patricktoulon

re

l'erreur c'est normal étant donné que la touche capture active une autre app que celle d'origine la capture n'est pas effectuée
donc OK La méthode capture pas possible
et bien mon pauvre il te reste plus que le sheets("masque")
avec 100 userforms bon courage :ptdr:
surtout que tu est parti avec des noms de fou dans tes userforms et qu'il faut les faire correspondre a chaque cellules correspondante dans la plage masque
perso pour utiliser le masque
j'aurais mis au controls le nom des cellules correspondantes dans chaque userform
et dans un simple boucle range("xx")=controls("xx")

sincèrement je dirais a mon patron /chef d'aller voir ailleurs si l'herbe elle est plus verte :ptdr:

a moins que tu soit payé pour ca :alors la c'est une autre histoire: peut être n'a t il pas placé le bon bonhomme a ce post

sinon tu peux lui expliquer que ce n'est pas ton métier et que si il veut voir la performance s'accroitre il ferait mieux de s'y mettre ou d'en parler a la maison mère

3 pages parce que tes supérieurs ne veulent pas investir quelques centaines d'euros dans un system de communication digne de ce nom en 2017 ca montre bien la qualité de l'entreprise
c'est absolument stupéfiant

si tu trouve un autre boulot tire toi vite :ptdr:
20/10/2017, 15h30
Denis_67

GRAND MERCI pour l'énergie déployée,
J'espère qu'elle sera utilisée (utilisable) dans un autre contexte.

Je te rassure, sur les 100 documents la plupart sont sur deux colonne et j'ai utilisé une codage simplifié ça fonctionne depuis le début.
Je génère un tableau html à deux colonnes
il reste quelques masques à créer pour les cas compliqués .
Je reviendrai peut etre vers toi pou l'envoi d'une portion de tableau si j'ai un souci de transmission, mais j'avais testé ton post et ça marchait y compris l'envoi Outlook.

J'espère que tu n'es pas trop frustré de t'être laissé entrainé dans ce binz.

en tout cas encore merci.
Je clos le post.
@bientôt, j'en sus sûr.
Denis
20/10/2017, 15h41
patricktoulon

re

envoie moi tout tes userforms sur un depots de file ou dropbox si c'est trop gros je vais regarder

en l'occurrence avec tes 5 userforms en exemples que tu m'a donné j'ai eu l'idée de faire un seul masque et la construction se fait avec seulement les lignes remplies en fonction de l'userform

mais attention je renomme tout tes controls sinon c'est la berizina le control qui rempli la cellule"d5" par exemple s'appellera "d5" et ainsi de suite
d'autant plus que dans tes exemples certains sont rempli en dur il n'y a donc pas besoins de les faire correspondre .ecrit en dur dans le masque aussi et c'est parti
20/10/2017, 15h48
patricktoulon

re

maintenant si tu veux tout sur 2 colonnes il n'y a même plus besoins de masque!!!
25/10/2017, 21h14
Denis_67

1 pièce(s) jointe(s)

Pour illustrer mon test Patrick
Pièce jointe 322396
25/10/2017, 21h58
patricktoulon

re

c'est quoi ces capture tu l'a fait avec ce que je t ai donné en mp???
ca fonctionne aussi chez toi alors?
25/10/2017, 22h04
patricktoulon

re

a ok j'ai pigé j'avais la moitié de la réponse en mp
bon si je comprends bien tu a le screen complet avec echape belle

a tu bien bloqué tout le code a l'intérieur du clik bouton?
il me semble que tu select et alimente des cellules peut être est cela
sinon je vois pas la capture doit se faire toujours sur l'userform puisque c'est lui qui est sensé être la fenêtre active
il me faut ce P.... de fichier en entier que je t'adapte la chose et que l'on en parle plus
en tout cas comme tu vois je t'ai trouvé le moyen de capturer sans la touche print

bon
voila ton truc comment je le vois
dans un module standard tu met ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal Hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal Hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal Hdc As Long, ByVal hObject As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal Hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function SetPixel Lib "gdi32" (ByVal Hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal Hdc As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    BOTTOM As Long
End Type
Const SRCCOPY = &HCC0020
Public chemin_image As String
Sub captur_USERFORM(usf)
    Dim ActiveHwnd As Long
    Dim DeskHwnd As Long
    Dim ForegroundHwnd As Long
    Dim Hdc As Long
    Dim hdcMem As Long
    Dim RECT As RECT
    Dim action As Long
    Dim fwidth As Long, fheight As Long
    Dim hBitmap As Long
    '---------------------------------------------------
    ' determination du handle de la fentre active
    '---------------------------------------------------
    DeskHwnd = GetDesktopWindow()
    ActiveHwnd = GetActiveWindow()
    '---------------------------------------------------
    'determination du rectangle de capture avec les coordonnée de la fentre active
    '---------------------------------------------------
    Call GetWindowRect(ActiveHwnd, RECT)
    fwidth = (RECT.Right - RECT.Left)
    fheight = (RECT.BOTTOM - RECT.Top)
    '---------------------------------------------------
    ' determination du contexte HDC du desktop
    '---------------------------------------------------
    Hdc = GetDC(DeskHwnd)
    hdcMem = CreateCompatibleDC(Hdc)
    hBitmap = CreateCompatibleBitmap(Hdc, fwidth - 9, fheight - 24)
    If hBitmap <> 0 Then
        action = SelectObject(hdcMem, hBitmap)
 
        action = BitBlt(hdcMem, 0, 0, fwidth - 9, fheight - 24, Hdc, RECT.Left + 4.5, RECT.Top + 24, SRCCOPY)
 
        '---------------------------------------------
        ' vidage et mise en memoire de l'image bitmap dans le clipboard
        '---------------------------------------------
        action = OpenClipboard(0)
        action = EmptyClipboard()
        action = SetClipboardData(2, hBitmap)
        action = CloseClipboard()
    End If
    chemin_image = Environ("userprofile") & "\Desktop\" & usf.Name & ".jpg"
    With ActiveSheet
        .Paste
        Set shap = .Shapes(shapecount)
        shap.Copy
        .ChartObjects.Add(0, 0, shap.Width, shap.Height).Chart.Paste
        .ChartObjects(1).Chart.Export Filename:=chemin_image, FilterName:="jpg"
        .ChartObjects(1).Delete
        shap.Delete
    End With
 
    '---------------------------------------------
    ' Clean up handles
    '---------------------------------------------
    action = DeleteDC(hdcMem)
    action = ReleaseDC(DeskHwnd, Hdc)
End Sub

exemple comme le bouton dans l'usf echapebelle
comme tu peux le voir avant tout le reste du code je capture!!!! c'est absolument primordiale

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub CommandButton4_Click()
captur_USERFORM Me
Col_Masque = "O"
Nb_col = 9
Chemin = "G:\PROCEDURES UTILISATEURS\CLEFS (Key users)\Bases_préenregistrés\"
DataBase = "A001_Echapee_belle_danger.xlsx"
Sheets("Masque").Range("CT3").Value = Sheets("Accueil").Range("J1").Value + 1
Sheets("Accueil").Range("J1").Value = Sheets("Accueil").Range("J1").Value + 1
   Envoie_Mail
Unload Me
End Sub

tu peux déjà regarder sur ton bureau la capture est la!!!
après dans ta sub mail Outlook tu peux joindre l'image dans les pièces jointes ou dans le corps
le chemin de l'image c'est "chemin_image" c'est toujours pareil pour tout tes userforms

tu vois c'est pas compliqué

Voir 40 message(s) de cette discussion en une page