UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se puede subir archivos al foro, favor de hacerlo en servidor externo (Dropbox, Drive...) y dejan link. "Sin archivo no hay respuestas"

Favor de leer "Todos los temas" Click aquí.

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

txingui


Hola a todos, tengo un excel con las macros y llamada a funciones necesarias para "personalizar" la apariencia de una hoja excel ocultando todos los comandos/herramientas del mismo pero me da error cuando lo utilizo en versiones superiores a 2010 y 64 bit, el tema es que no se adaptarlas (Ptr...), agradecería si alguno de los expertos me da una ayuda con las líneas a añadir...., dejo las macros y funciones aquí

un saludo y gracias


Option Explicit
Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function GetWindowLong32 Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
Declare Function SetWindowLong32 Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Integer, ByVal nIndex As Integer, _
ByVal dwNewLong As Long) As Long
Global Const GWL_STYLE = (-16)
Global Const WS_SYSMENU = &H80000

Sub Reponer_cabecera()
Dim WindowStyle As Long
Dim hWnd As Integer
Dim WindowName As String
Dim Result As Variant
Application.ScreenUpdating = True '
Application.EnableCancelKey = xlDisabled
On Error Resume Next
WindowName = Application.Caption
hWnd = FindWindow32(0&, ByVal WindowName)
WindowStyle = GetWindowLong32(hWnd, GWL_STYLE)
WindowStyle = WindowStyle Or WS_SYSMENU
Result = SetWindowLong32(hWnd, GWL_STYLE, WindowStyle)
Application.Caption = " "
End Sub

Sub Retirar_cabecera()
Dim WindowStyle As Long
Dim hWnd As Integer
Dim WindowName As String
Dim Result As Variant
Application.EnableCancelKey = xlDisabled
On Error Resume Next
Application.ScreenUpdating = False
WindowName = Application.Caption
hWnd = FindWindow32(0&, ByVal WindowName)
WindowStyle = GetWindowLong32(hWnd, GWL_STYLE)
WindowStyle = WindowStyle And (Not WS_SYSMENU)
Result = SetWindowLong32(hWnd, GWL_STYLE, WindowStyle)
Application.Caption = " "

End Sub

Sub cabecera_excel_mostrar()
Application.EnableCancelKey = xlDisabled
On Error Resume Next
Application.ExecuteExcel4Macro "show.toolbar(""ribbon"",true)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
With Application
.WindowState = xlMaximized
End With
End Sub

Sub ocultar_todo()
Application.EnableCancelKey = xlDisabled
On Error Resume Next
Sheets("INICIO").Select
Application.ExecuteExcel4Macro "show.toolbar(""ribbon"",false)"
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
With Application
.WindowState = xlMaximized
End With
Call Retirar_cabecera
End Sub

JoaoM


Aqui un ejemplo. adaptalo a tu necesidad

'APIs, Para que funcione con Office X86 y X64
    'Validamos la versión de Office
    #If VBA7 And Win64 Then
        'Si es de 64 bits
        Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
                ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
    #Else
        'Si es de 32 bits
        Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    #End If

txingui


Gracias JoaoM

4RESUELTO Consulta el 28/08/18, 02:10 pm

TOGOLO


Estimados les consulto si la macro que pusieron se coloca en Thisworkbook??
Soy novato para las Macros.
Gracias

txingui


En un módulo y desde thisworkbook haces la llamada a ocultar_todo, la macro cabecera_excel_mostrar pondrá en pantalla las opciones ocultadas

Igtelo

avatar
Resuelto y cierro.

Ignacio Téllez

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.