MsgBox personalizada

Bom dia, amigos e mestres.

Em contínua busca pela MsgBox modal perfeita, encontrei esse código que me atendeu perfeitamente.
Além de mudar os textos dos botões ao meu gosto, muda os ícones.
Espero que sirva a todos.

'-------Início do código para um módulo qualquer------------------

'*********************************************************
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
' accessvba@ya.com
'
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
'---------------------------------------------------------
' Nombre : MsgBoxEx
' Creación : 18/11/2004
' Autor : Juan M. Afán de Ribera
' Propósito : Extender las posibilidades del MsgBox de
' Visual Basic, pudiendo mostrar iconos
' personalizados en la barra de título, iconos
' y cursores animados en la ventana de cliente,
' así como cambiar el texto de los botones.
'
'*********************************************************
Option Compare Database
Option Explicit

' Función que establece el texto de una ventana
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long

' Función que devuelve el manipulador de una ventana
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

' Función que devuelve el nombre de clase de una ventana
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

' Función que devuelve el ID del control de un cuadro de diálogo
Private Declare Function GetDlgCtrlID Lib "user32" _
(ByVal hwnd As Long) As Long

' Función que envía un mensaje al control de un cuadro de diálogo
Private Declare Function SendDlgItemMessage Lib "user32" _
Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long

' Función que devuelve el manipulador de una imagen
Private Declare Function LoadImage Lib "user32" _
Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) As Long

' Función que envía un mensaje a una ventana
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

' Función que devuelve el manipulador de la ventana activa en ese momento
Private Declare Function GetForegroundWindow Lib "user32" () As Long

' Función que devuelve información de una ventana
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

' Función que crea un Timer de sistema
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

' Función que destruye un timer de sistema
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

' constante para escribir un texto
Private Const WM_SETTEXT = &HC
' constante para establecer un icono
Private Const WM_SETICON = &H80
' constante para establecer la imagen de un control Static
Private Const STM_SETIMAGE = &H172
' constante que indica que se llama a una imagen tipo icono
Private Const IMAGE_ICON = 1
' constante que indica que la imagen proviene de un fichero
Private Const LR_LOADFROMFILE = &H10
' constante para llamar a una ventana hija
Private Const GW_CHILD = 5&
' constante para llamar a la siguiente ventana
Private Const GW_HWNDNEXT = 2&
' constante de estilo para poder contener un icono
Private Const SS_ICON = &H3&
' constante para devolver información del estilo de una ventana
Private Const GWL_STYLE = (-16)

' variables globales de MsgBoxEx
Private hMsgBox As Long
Private hIconWindow As Long
Private hIconBar As Long
Private Title2 As String
Private ButtonsText(1 To 7) As String

Public Function MsgBoxEx( _
Prompt, _
Optional buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title, _
Optional HelpFile, _
Optional Context, _
Optional IconBar As String, _
Optional IconWindow As String, _
Optional BtOk As String, _
Optional BtCancel As String, _
Optional BtAbort As String, _
Optional BtRetry As String, _
Optional BtIgnore As String, _
Optional BtYes As String, _
Optional BtNo As String) As VbMsgBoxResult

If hMsgBox = 0 Then
ButtonsText(1) = BtOk ' Texto botón Ok - IDControl = vbOk = 1
ButtonsText(2) = BtCancel ' Texto botón Cancelar/Aceptar - IDControl = vbCancel = 2
ButtonsText(3) = BtAbort ' Texto botón Anular - IDControl = vbAbort = 3
ButtonsText(4) = BtRetry ' Texto botón Reintentar - IDControl = vbRetry = 4
ButtonsText(5) = BtIgnore ' Texto botón Ignorar - IDControl = vbIgnore = 5
ButtonsText(6) = BtYes ' Texto botón Sí - IDControl = vbYes = 6
ButtonsText(7) = BtNo ' Texto botón No - IDControl = vbNo = 7

' si se ha indicado un icono para la barra de título
If IconBar <> "" Then
' se obtiene un manipulador de la imagen
hIconBar = hIcon(IconBar, 16&)
' añadimos unos cuantos blancos para hacer sitio
' en la barra de título para el icono, pues el
' MsgBox no está originalmente preparado para ello
Title2 = Title
Title = Title & String(6, Chr(32))
Else
' si no, ponemos posibles valores anteriores de hIconBar a 0
hIconBar = 0
End If

' necesitamos comprobar que se puede cargar la imagen
' correspondiente a la ventana cliente del MsgBox, para
' configurar el espacio correspondiente al icono. Si la
' ruta fuera incorrecta y no se comprobara, quedaría un
' espacio en blanco correspondiente al control Static
' que contiene estos iconos.

If IconWindow <> "" Then
hIconWindow = hIcon(IconWindow, 32&)
' si se ha podido cargar la imagen, anulamos cualquier
' llamada del usuario a los iconos de mensaje
' predeterminados ...
If hIconWindow Then
If (buttons And vbCritical) = vbCritical Then
buttons = buttons - vbCritical
ElseIf (buttons And vbExclamation) = vbExclamation Then
buttons = buttons - vbExclamation
ElseIf (buttons And vbInformation) = vbInformation Then
buttons = buttons - vbInformation
ElseIf (buttons And vbQuestion) = vbQuestion Then
buttons = buttons - vbQuestion
End If
' y ponemos nosotros uno cualquiera de ellos.
' De esta manera aseguramos que existirá un control
' Static para contener nuestro icono/imagen personalizado.
buttons = buttons + vbCritical
End If
Else
hIconWindow = 0
End If

' Creamos un timer que se ejecutará a la décima de segundo
Call SetTimer(hWndAccessApp, 0&, 10, AddressOf TimerProc)
' llamamos al MsgBox de manera normal
On Error GoTo AnularTimer
' llamamos al MsgBox de VBA con los parámetros normales
MsgBoxEx = MsgBox(Prompt, buttons, Title, HelpFile, Context)
End If

Exit Function

AnularTimer:
' si ha habido algún error, se cancela la operación
Call KillTimer(hWndAccessApp, 0&)
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description

End Function

' Esta función se ejecutará una décima de segundo después de llamar
' al MsgBox (en modo asíncrono) y "capturará" el cuadro de diálogo
' y sus controles para poder manipularlos
'
Private Sub TimerProc( _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)

Dim cnt As Long

' capturamos el manipulador del MsgBox
hMsgBox = GetForegroundWindow

' si se ha indicado un icono para la barra de título
If hIconBar Then
' se carga
Call SendMessage(hMsgBox, WM_SETICON, 0&, ByVal hIconBar)
Call SetWindowText(hMsgBox, Title2)
End If

' si se ha indicado un icono para la ventana de cliente
If hIconWindow Then
' se carga - CtrlId devolverá el ID del control que contiene el icono
Call SendDlgItemMessage(hMsgBox, CtrlId, STM_SETIMAGE, IMAGE_ICON, hIconWindow)
End If

' ponemos el texto a los botones (si lo hay)
For cnt = 1 To 7
' si se ha indicado un texto para alguno de los botones
If ButtonsText(cnt) <> "" Then
' se cambia su texto.
' cnt = número de ID de control de cada uno de los botones
' dentro del cuadro de diálogo
Call SendDlgItemMessage(hMsgBox, cnt, WM_SETTEXT, 0&, ButtonsText(cnt))
End If
Next

' anulamos el timer, ya que sólo se ejecutará una vez (de momento)
Call KillTimer(hWndAccessApp, 0&)
hMsgBox = 0

End Sub

' función que devuelve el manipulador de una imagen
' para este código me he basado en el ejemplo que amablemente proporciona
' Klaus Probst en http://www.mvps.org/access/api/api0043.htm
'
Function hIcon(IconPath As String, IconSize As Long) As Long
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, IconSize, IconSize, LR_LOADFROMFILE)
End Function

' Esta función devuelve el ID del control Static que contiene los iconos
' de la ventana cliente del MsgBox.
' El ID de este control, junto con el ID del control Static que contiene
' el texto del MsgBox varía entre versiones, tanto de Access como del sistema
' operativo, así que he tenido que crear una función que lo localizara.
' Se le puede localizar, primero por el tipo de control (Static) y
' después por el estilo SS_ICON, que es un estilo (atributo) que permite al
' control contener un icono y expandirse según su tamaño
'
Function CtrlId() As Long
Dim buffer As String * 100
Dim hwnd As Long
Dim CurStyle As Long

' obtenemos la primera ventana hija del MsgBox
hwnd = GetWindow(hMsgBox, GW_CHILD)
Do While hwnd
' obtenemos el nombre de la clase de ventana
GetClassName hwnd, buffer, 100
' si es de la clase Static
If UCase(Left(buffer, 6)) = "STATIC" Then
CurStyle = GetWindowLong(hwnd, GWL_STYLE)
' si tiene el estilo SS_ICON
If (CurStyle And SS_ICON) = SS_ICON Then
' obtenemos el número de ID del control
CtrlId = GetDlgCtrlID(hwnd)
Exit Function
End If
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop

End Function


'-------Final do código para um módulo qualquer------------------

'-------Início da chamada da MsgBoxPessoal------------------

Dim PerText As String
PerText = MsgBoxEx("Qual o Processo a ser utilizado?", _
vbYesNoCancel, _
"Projeto Teen's", _
, _
, _
"Caminho para o ícone", _
"Caminho para o ícone", _
"oK", _ '--------Botão VbOk
"Cancelar", _ '--------Botão VbCancel
"Abortar", _
"Repetir", _
"Ignorar", _
"Atualizar", _ '--------Botão VbYes
"Novo registro")'--------Botão VbNo

'---------- Mude o texto para os botões


Select Case PerText
Case "7" '------Botão VbNo
'----Aqui o código

Case "6" '------Botão VbYes------ Botões numerados no módulo
'----Aqui o código

End Select

'-------Final da chamada da MsgBoxPessoal------------------

Obrigado pela contribuíção, vai ajudar em muitas duvidas aqui.

Obrigado pelo compartilhamento

Bom dia, mestres.

Apenas tentando devolver um pouco da ajuda que já recebi desse Fórum.

Cumprimentos.

Obrigado por postar.
Gosto muito desse Forum pois muita gente ajuda mesmo.
Abrçs.