Necesito de su ayuda quisiera cambiar este título: “PUBLICACIÓN. . .”, por otro. Esto sucede cuando estoy exportándolo o convirtiéndolo a PDF una hoja de Excel.
Aquí les dejo la MACRO:

Sub Imprimir()
If MsgBox("¿Estás seguro que deseas imprimir el archivo.?", vbQuestion + vbOKCancel, "HOLA") = vbOK Then
MsgBox "Procediendo con la impresión del archivo. . .", vbInformation, "HOLA"
MsgBox "Seleccione la ubicación o Directorio a guardar su archivo .PDF. . . !", vbExclamation, "HOLA"
'nombre = WorksheetFunction.Text(Now(), "dd-mmm-yyyy-O-hh-mm-ss")

nombre = "HOLA"

ruta = Application.GetSaveAsFilename(nombre, "Pdf,*.pdf", , "Guardar como")
If ruta <> False Then

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta, OpenAfterPublish:=1

MsgBox "El archivo impreso, se guardó en:" & vbCr & ruta, vbInformation, "HOLA"

Else
MsgBox "Haz cancelado la impresión del archivo.", vbCritical, "HOLA"
End If

Else
MsgBox "Haz cancelado la impresión del archivo.", vbCritical, "HOLA"
End If
End Sub

Aquí les dejo una imagen:

http://oi68.tinypic.com/2zfl3rl.jpg

Editado el el 15 de diciembre6 años por 6luishao6

Hola

Pues no, no puedes usar macros para cambiar ese título del cuadro de diálogo. 

Abraham Valencia

Que tendría que hacer?.

Gracias.

?

 

Hola

A través de " ScreenUpdating" o de "DisplayAlerts" pues, como ya te diste cuenta, no podrás evitarlo y no, no hay otra instrucción de VBA con la que puede evitarse ese aviso.

Puede hacerse con Hook y funciones de la API de Windows, pero debes probar que tal te va:

Public Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Public Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_HIDE = 0
Public Const DLG_CLSID = "CMsoProgressBarWindow"
Public Const EVENT_SYSTEM_FOREGROUND = &H3&
Public Const WINEVENT_OUTOFCONTEXT = 0
Dim long_WinEventHook As Long

Function StartEventHook() As Long
long_WinEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
StartEventHook = long_WinEventHook
End Function

Sub StopEventHook()
Dim b_unhooked As Boolean

If long_WinEventHook = 0 Then
    MsgBox "WinEventHook no ha podido detenerse, recomiendo resetear la PC"
    Exit Sub
End If

b_unhooked = UnhookWinEvent(long_WinEventHook)

If b_unhooked = True Then
Else
    MsgBox "WinEventHook no ha podido detenerse, recomiendo resetear la PC"
End If
End Sub

Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long

On Error Resume Next

Dim l_handle As Long
Dim s_buffer As String
Dim b_visible As Boolean
Dim i_bufferLength As Integer

s_buffer = String$(32, 0)
i_bufferLength = apiGetClassName(hWnd, s_buffer, Len(s_buffer))

If Left(s_buffer, i_bufferLength) = DLG_CLSID Then
    b_visible = apiShowWindow(hWnd, SW_HIDE)
    WinEventFunc = hWnd
End If
End Function

Sub ExportaraPDF()
Call StartEventHook
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\MiArchivo.pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
Call StopEventHook
End Sub

 

Obviamente en la macro "ExportaraPDF" debes reemplazar el "Activesheet" por tu hoja y/o rango así como reemplazar la ruta por la que tú deseas. Ah, otra cosa, las declaraciones de funciones de la API de Windows están hechas para hacerlas en Office de 32 bits, pero si tu Office es de 64 bits no es nada difícil cambiarlo (OJO, Office, no confundir con el Windows)

Saludos

Abraham Valencia

Graci

En 1/1/2019 at 17:58 , avalencia dijo:

Hola

A través de " ScreenUpdating" o de "DisplayAlerts" pues, como ya te diste cuenta, no podrás evitarlo y no, no hay otra instrucción de VBA con la que puede evitarse ese aviso.

Puede hacerse con Hook y funciones de la API de Windows, pero debes probar que tal te va:

Public Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Public Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_HIDE = 0
Public Const DLG_CLSID = "CMsoProgressBarWindow"
Public Const EVENT_SYSTEM_FOREGROUND = &H3&
Public Const WINEVENT_OUTOFCONTEXT = 0
Dim long_WinEventHook As Long

Function StartEventHook() As Long
long_WinEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
StartEventHook = long_WinEventHook
End Function

Sub StopEventHook()
Dim b_unhooked As Boolean

If long_WinEventHook = 0 Then
    MsgBox "WinEventHook no ha podido detenerse, recomiendo resetear la PC"
    Exit Sub
End If

b_unhooked = UnhookWinEvent(long_WinEventHook)

If b_unhooked = True Then
Else
    MsgBox "WinEventHook no ha podido detenerse, recomiendo resetear la PC"
End If
End Sub

Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long

On Error Resume Next

Dim l_handle As Long
Dim s_buffer As String
Dim b_visible As Boolean
Dim i_bufferLength As Integer

s_buffer = String$(32, 0)
i_bufferLength = apiGetClassName(hWnd, s_buffer, Len(s_buffer))

If Left(s_buffer, i_bufferLength) = DLG_CLSID Then
    b_visible = apiShowWindow(hWnd, SW_HIDE)
    WinEventFunc = hWnd
End If
End Function

Sub ExportaraPDF()
Call StartEventHook
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\MiArchivo.pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
Call StopEventHook
End Sub

 

Obviamente en la macro "ExportaraPDF" debes reemplazar el "Activesheet" por tu hoja y/o rango así como reemplazar la ruta por la que tú deseas. Ah, otra cosa, las declaraciones de funciones de la API de Windows están hechas para hacerlas en Office de 32 bits, pero si tu Office es de 64 bits no es nada difícil cambiarlo (OJO, Office, no confundir con el Windows)

Saludos

Abraham Valencia

Gracias