cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
15 déc. 2006 à 19:52
Bonsoir,
Une autre solution, si vous voulez utiliser du vbs, c'est que celui-ci construise votre macro,
comme dans l'exemple ci-dessous:
Set sh = WScript.CreateObject("WScript.Shell")
on error resume next
sh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\accessVBOM",1,"REG_DWORD"
on error goto 0
Set exl = WScript.CreateObject("excel.Application")
exl.Visible = false
set fichxl=exl.workbooks.add
Set mdle = fichxl.VBProject.VBComponents.Add(1)
num=0
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function GetDC Lib ""user32"" (ByVal hwnd As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function TextOut Lib ""gdi32"" Alias ""TextOutA"" ( _ "
num=num+1:mdle.CodeModule.InsertLines num, " ByVal hdc As Long, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal x As Long, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal y As Long, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal lpString As String, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal nCount As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function SetTextColor Lib ""gdi32"" ( _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal hdc As Long, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal crColor As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function SetBkMode Lib ""gdi32"" ( _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal hdc As Long, _ "
num=num+1:mdle.CodeModule.InsertLines num, "ByVal nBkMode As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function SetRect Lib ""user32"" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Declare Function DrawText Lib ""user32"" Alias ""DrawTextA"" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long"
num=num+1:mdle.CodeModule.InsertLines num, "Private Type RECT"
num=num+1:mdle.CodeModule.InsertLines num, " Left As Long"
num=num+1:mdle.CodeModule.InsertLines num, " Top As Long"
num=num+1:mdle.CodeModule.InsertLines num, " Right As Long"
num=num+1:mdle.CodeModule.InsertLines num, " Bottom As Long"
num=num+1:mdle.CodeModule.InsertLines num, "End Type"
num=num+1:mdle.CodeModule.InsertLines num, "Sub ecriture_en_rouge_sur_fond_transparent()"
num=num+1:mdle.CodeModule.InsertLines num, "Dim rct As RECT"
num=num+1:mdle.CodeModule.InsertLines num, "fen = GetDC(0)"
num=num+1:mdle.CodeModule.InsertLines num, "SetRect rct, 250, 250, 500, 500"
num=num+1:mdle.CodeModule.InsertLines num, "Call SetBkMode(fen, 1) "
num=num+1:mdle.CodeModule.InsertLines num, "Call SetTextColor(fen, vbRed)"
num=num+1:mdle.CodeModule.InsertLines num, "txt = ""Avec les fonctions API, on peut écrire n'importe où sur l'écran. On peut utiliser les API en VBScript en les lançant sous VBA Excel"""
num=num+1:mdle.CodeModule.InsertLines num, "Call DrawText(fen, txt, Len(txt), rct, &H10)"
num=num+1:mdle.CodeModule.InsertLines num, "End Sub"
exl.Run "ecriture_en_rouge_sur_fond_transparent"
fichxl.close(false)
exl.quit
Set fichxl=nothing
set mdle=nothing
set exl=nothing
set sh=Nothing
jean-marc