The Commands in the popup menu are disabled

[Urpiano Cedazo]

Hi all:

First of all, I must apologize for my poor English.

I have developed an Autpen macro that runs a slide show generating each
slide on run time reading the contents from an Excel book, in a non exit
loop. It works fine and I can stop the slide show with a right click and
executing "Stop slide show" (I'm not sure if this is the exact command name,
my PP is in Spanish).

When I save as addin and load the saved addin, the slide show starts with no
problem, but I can not stop the slide show with de "Stop slide show"
command, because de popup menu has all its commands disabled. Does anybody
knows how to change this behaviour?

TIA

 

[Urpiano Cedazo]

Hi:

I'd forgotten to said that PP is 2003 version. And here is the code:

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Column constants
Public Const COL_HOTEL = "A"
Public Const COL_ESTRELLAS = "H"
Public Const COL_POBLACION = "B"
Public Const COL_PROVINCIA = "C"
Public Const COL_PAIS = "D"
Public Const COL_FECHAS = "E"
Public Const COL_TALONES = "F"
Public Const COL_REGIMEN = "G"


Sub Autpen()

Dim app_Excel As New Excel.Application
Dim wb_Libro As Excel.Workbook
Dim ws_Hoja As Worksheet
Dim lng_Linea As Long

Dim app_PowerPoint As New PowerPoint.Application
Dim pre_Ofertas As Presentation
Dim sld_Diapositiva As Slide
Dim str_Plantilla As String
Dim obj_FSO As New FileSystemObject

Dim str_Hotel As String, str_Estrellas As String, _
str_Poblacion As String, str_Provincia As String
Dim str_Pais As String, str_Fechas As String, _
str_Talones As String, str_Regimen As String
Dim str_EtiquetaTalones As String
Dim lng_ColorTalones As Long

On Error GoTo ctrl_Errores


' Get a reference to your add-in.
If AddIns.Count > 0 Then


With AddIns(AddIns.Count)

' Create the registry key in HKEY_CURRENT_USER.
.Registered = msoTrue

' Set the AutoLoad value in the registry.
.AutoLoad = msoTrue

' Makes sure that the add-in is loaded.
.Loaded = msoTrue

End With

End If

'The Excel worksheet has column headers, so the 1st line
'to read is the sheet's 2nd line
lng_Linea = 2

'Creating new presentation
Set pre_Ofertas = app_PowerPoint.Presentations.Add

'Adding a blank slide to the presentation
pre_Ofertas.Slides.Add 1, ppLayoutBlank

'Setting transition properties
With pre_Ofertas.Slides.Range.SlideShowTransition

.AdvanceTime = 5
.EntryEffect = ppEffectRandom

End With

'Setting Slide Show Settings and running it
With pre_Ofertas.SlideShowSettings

.Run
.AdvanceMode = ppSlideShowManualAdvance
.ShowWithAnimation = msoTrue

End With

'Hidding mouse cursor
pre_Ofertas.SlideShowWindow.View.PointerType = _
ppSlideShowPointerAlwaysHidden

Do

'Copyin Excel's workbook (this workbook has the data)
obj_FSO.CopyFile "\\server\folder\hotels.xls", _
"\\server\folder\hotels1.xls", True

'Opening the copy
Set wb_Libro = app_Excel.Workbooks.Open("\\server\folder\hotels1.xls", _
ReadOnly:=True)
Set ws_Hoja = wb_Libro.Worksheets(1)

'If the sheet's current line is blank then return to the 2nd line
If ws_Hoja.Range("A" & lng_Linea).Value = "" Then

lng_Linea = 2
GoTo NuevaVuelta

End If

'Reading the data and charging it onto variables
With ws_Hoja

str_Hotel = ws_Hoja.Range(COL_HOTEL & lng_Linea).Value
str_Estrellas = ws_Hoja.Range(COL_ESTRELLAS & lng_Linea).Value
str_Poblacion = ws_Hoja.Range(COL_POBLACION & lng_Linea).Value
str_Provincia = ws_Hoja.Range(COL_PROVINCIA & lng_Linea).Value
str_Pais = ws_Hoja.Range(COL_PAIS & lng_Linea).Value
str_Fechas = ws_Hoja.Range(COL_FECHAS & lng_Linea).Value
str_Talones = ws_Hoja.Range(COL_TALONES & lng_Linea).Value
str_Regimen = ws_Hoja.Range(COL_REGIMEN & lng_Linea).Value

'Setting plural or singular label
If CInt(str_Talones) = 1 Then

str_EtiquetaTalones = "Talón/Noche"

Else

str_EtiquetaTalones = "Talones/Noche"

End If

End With

'Closing workbook
wb_Libro.Close

'Deleting copy
obj_FSO.DeleteFile "\\server\folder\hotels1.xls", True

'Diferent colors in check number function
Select Case CInt(str_Talones)

Case 1 'Rosa

lng_ColorTalones = RGB(254, 194, 215)

Case 2 'Azul

lng_ColorTalones = RGB(184, 208, 246)

Case 3 'Amarillo

lng_ColorTalones = RGB(252, 254, 176)

Case 4 'Verde

lng_ColorTalones = RGB(146, 216, 136)

Case 5 'Naranja

lng_ColorTalones = RGB(247, 196, 105)

Case Else 'Blanco

lng_ColorTalones = RGB(255, 255, 255)

End Select

'Creating slide
Set sld_Diapositiva = ActivePresentation.Slides.Add(1, ppLayoutText)

'Applying template to the slide
sld_Diapositiva.ApplyTemplate "\\server\folder\hotels.pot"

'If there are three slide the 2dn will be deleted
If pre_Ofertas.Slides.Count > 2 Then ActivePresentation.Slides(2).Delete

'Writing data onto title
sld_Diapositiva.Shapes.Title.TextFrame.TextRange.Text = str_Hotel & " " & _
str_Estrellas & vbCrLf & _
str_Poblacion & " (" & _
str_Provincia & ") " & _
str_Pais & vbCrLf & _
str_Talones & " " & str_EtiquetaTalones

'Formatting tittle text
With sld_Diapositiva.Shapes(1).TextFrame.TextRange

.Characters(1, Len(str_Hotel & " " & str_Estrellas)).Font.Bold = msoTrue
.Characters(Len(str_Hotel) + 2, Len(str_Estrellas)).Font.Name = "Wingdings 2"
.Characters(Len(str_Hotel) + 2, Len(str_Estrellas)).Font.Color.RGB = RGB(255, 230, 0)
.Characters(Len(str_Hotel & " " & str_Estrellas) + 1, _
Len(sld_Diapositiva.Shapes(1).TextFrame.TextRange.Text)).Font.Bold = msoFalse
.Characters(Len(.Text) - Len(str_Talones & " " & str_EtiquetaTalones) + 1, _
Len(str_Talones & " " & str_EtiquetaTalones)).Font.Color.RGB = lng_ColorTalones
.Characters(Len(.Text) - Len(str_Talones & " " & str_EtiquetaTalones) + 1, _
Len(str_Talones & " " & str_EtiquetaTalones)).Font.Bold = msoTrue

End With

'Writing data onto text and formatting it
With sld_Diapositiva.Shapes(2).TextFrame.TextRange

.Text = "Fechas: " & str_Fechas & vbCrLf & _
"Régimen: " & str_Regimen

.Characters(Len("Fechas: ") + 1, Len(str_Fechas)).Font.Bold = msoTrue
.Characters(Len("Fechas: ") + Len(str_Fechas) + Len("Régimen: ") + 2, _
Len(str_Regimen)).Font.Bold = msoTrue

End With

'Moving to the created slide
pre_Ofertas.SlideShowSettings.Run.View.GotoSlide 1

'Waiting 20 seconds
DoEvents
Sleep 20000

'Seeking if the slide show is ended
If Not pre_Ofertas.SlideShowWindow.View.State = ppSlideShowRunning Then

pre_Ofertas.SlideShowWindow.View.Exit

FinDePresentacion:

pre_Ofertas.Slides(1).Delete
pre_Ofertas.Close
Exit Do

End If

'Adding 1 to the worksheet line counter
lng_Linea = lng_Linea + 1

NuevaVuelta:

Loop


FinDeProcedimiento:

'Quitting and emptying
Set ws_Hoja = Nothing
Set wb_Libro = Nothing
app_Excel.Quit
Set app_Excel = Nothing
Set obj_FSO = Nothing
app_PowerPoint.Quit
Set app_PowerPoint = Nothing
Exit Sub

ctrl_Errores:

If Err.Number = 1004 Then

pre_Ofertas.SlideShowWindow.View.Exit

ElseIf Err.Number = -2147188160 Then

Resume FinDePresentacion

Else

MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "bas_Ventas.Autpen"

End If

Resume FinDeProcedimiento

End Sub





--
Un Saludo
Urpiano Cedazo





Y fue Urpiano Cedazo ([email protected]) quien en el mensaje [email protected], planeando sobre su teclado, hizo un picado y tecleó: