Hello.

I have made four macros, that makes my teaching easier. But my college is on a Mac, where they wont work.

They manipulate timing of the slides and made a nice printeable teachers program (html file), when run on a PC. Any help on what lines, it is that is not Mac compatible and what to write insted He is on Office 2011 on the Mac and i´m on 2016 on the PC?


Here is the Macros:


Module 1:



Dim cPPTObject As New cEventClass


Dim TrapFlag As Boolean


Sub OpdaterTidNaarGemmer()
If TrapFlag = True Then
MsgBox "Relax, my friend, the EventHandler is already active.", vbInformation + vbOKOnly, "PowerPoint Event Handler Example"
Exit Sub
End If
Set cPPTObject.PPTEvent = Application
TrapFlag = True
End Sub


Sub ReleaseTrap()
If TrapFlag = True Then
Set cPPTObject.PPTEvent = Nothing
Set cPPTObject = Nothing
TrapFlag = False
End If
End Sub








Sub OpdaterTid()




Dim AllSlides As Slide
Dim FirstSlide As Slide


Dim CurrentMinutes As Integer
Dim TotalMinutes As Integer
Dim StartTime
StartTime = TimeValue("8:00 AM")


Dim CurrentTime As Date
Dim PasteTime As Date

Dim NextTime As Date
Dim NoteText As String
Dim RemoveTime As String

Set FirstSlide = ActivePresentation.Slides(1)
Set FirstNoteText = FirstSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange

'hvis der er en starttid
If InStr(FirstNoteText, "]") <> 0 Then
'Så træk den ud i StartTime
StartTime = Mid(FirstNoteText, InStr(FirstNoteText, "[") + 1, InStr(FirstNoteText, "]") - InStr(FirstNoteText, "[") - 1)
Else
'Eller skriv standard Starttid ind
FirstSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange = "[" + Format(StartTime, "h:nn") + "] " + FirstNoteText

End If

'Første Slide er CurrentTime det samme som StartTime
CurrentTime = StartTime
PasteTime = StartTime






For Each AllSlides In ActivePresentation.Slides
NoteText = AllSlides.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange


'Tjek om der er minutter findes
If InStr(NoteText, "))") <> 0 Then
'om de er forskellige fra 0
If Mid(NoteText, InStr(NoteText, "((") + 2, InStr(NoteText, "))") - InStr(NoteText, "((") - 2) <> 0 Then
'så sæt tiden der skal sættes ind til CurrentTime
PasteTime = CurrentTime
'ellers
End If


End If


'hvis der er en tid
If InStr(NoteText, "]") <> 0 Then

'Så erstat tiden med med CurrentTime
OwnTime = Mid(NoteText, InStr(NoteText, "[") + 1, InStr(NoteText, "]") - InStr(NoteText, "[") - 1)
AllSlides.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange = Replace(NoteText, OwnTime, Format(PasteTime, "h:nn"))





'Træk minutter ud af Parentes til CurrentMinute
If InStr(NoteText, "))") <> 0 Then
CurrentMinutes = Mid(NoteText, InStr(NoteText, "((") + 2, InStr(NoteText, "))") - InStr(NoteText, "((") - 2)
Else
CurrentMinutes = 0
'Og skriv 0 minutter ind
AllSlides.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange = Replace(NoteText, OwnTime + "]", OwnTime + "] ((0))")

End If


'Læg dem til CurrentTime

CurrentTime = DateAdd("n", CurrentMinutes, CurrentTime)

Else
'Eller skriv den nye tid ind
AllSlides.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange = "[" + Format(CurrentTime, "h:nn") + "] " + NoteText
End If









'Make the first line of Notes Bold
AllSlides.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Lines(Start: =1, Length:=1).Font.Bold = True



Next AllSlides


End Sub










Sub Lav_learerprogram()


Dim path As String
path = GetSetting("FPPT", "Export", "Default Path")




If path <> "" Then
'Open path For Output As #n
SaveSetting "FPPT", "Export", "Default Path", path
End If





Dim sImagePath_old As String
Dim sImagePath As String
Dim sImageName As String
Dim sPrefix As String
Dim oSlide As Slide '* Slide Object
Dim lScaleWidth As Long '* Scale Width

Dim lScaleHeight As Long '* Scale Height
On Error GoTo Err_ImageSave


Dim FirstLine As String
Dim FirstLineEx As String
Dim NoteTextEx As String
Dim MinutesEx As String
Dim TimeEx As String



Dim StartHTML As String
Dim TempHTML As String
Dim EndHTML As String

StartHTML = "<html><head><style>" + vbNewLine + vbNewLine _
+ "" _
+ "" _
+ "" _
+ "" _
+ "" _
+ vbNewLine + vbNewLine + "</style></head><body>" + vbNewLine + vbNewLine

TempHTML = ""
EndHTML = "</body></html>"










With Application.FileDialog(msoFileDialogFolderPicker)






sImagePath_old = ActivePresentation.path

sPrefix = Split(ActivePresentation.Name, ".")(0)


'Lav en folder til billederne med samme navn som PP
sImagePath = sImagePath_old + "\" + sPrefix
If Len(Dir(sImagePath, vbDirectory)) = 0 Then
MkDir sImagePath
End If



For Each oSlide In ActivePresentation.Slides

'Gem det aktuelle slide som JPG
sImageName = sPrefix & "-" & oSlide.SlideIndex & ".jpg"

oSlide.Export sImagePath & "\" & sImageName, "JPG"

'Træk info fra NoteFeltet
FirstLine = oSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Lines(Start:=1, Length:=1)
FirstLineEx = Mid(FirstLine, InStr(FirstLine, "))") + 2, Len(FirstLine))
NoteTextEx = oSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Lines(Start:=2, Length:=10)
'Fjern evt. tid og minutter her
If InStr(FirstLine, ")") <> 0 Then
MinutesEx = Mid(FirstLine, InStr(FirstLine, "((") + 2, InStr(FirstLine, "))") - InStr(FirstLine, "((") - 2)
Else
MinutesEx = "0"
End If

If InStr(FirstLine, "]") <> 0 Then
TimeEx = Mid(FirstLine, InStr(FirstLine, "[") + 1, InStr(FirstLine, "]") - InStr(FirstLine, "[") - 1)
End If


If MinutesEx = 0 Then
MinutesExHTML = ""
Else
MinutesExHTML = MinutesEx
End If




'Lav linien til html filen
TempHTML = TempHTML + "<div id=container style='float:left;font-weight:normal;color:#000000;background-color:#F3F5DA;font-size:8px;" _
+ "text-align:left;font-family:trebuchet MS, sans-serif;line-height:1;border:1px solid;margin:5px;padding:7px;height:321px;width:200px;" _
+ "-moz-box-shadow: 7px 5px 5px #141414;-webkit-box-shadow: 7px 5px 5px #141414;box-shadow: 7px 5px 5px #141414;" _
+ "'><div><div class=MinuteClass style='float:right;border-radius: 4px;margin: 3px 2px 2px; padding: 4px;font: normal 12px/1 Verdana, Geneva, sans-serif;color:white;background-color:green;'>" _
+ MinutesExHTML + "</div><div class=TimeClass style='float:left;border-radius: 4px;margin: 3px 2px 2px; padding: 4px;font: normal 12px/1 Verdana, Geneva, sans-serif;color:white;background-color:orange;'>" + TimeEx + "</div>" + "<div class=HeadingClass style='float:left:font-weight:bold;margin: 3px 2px 2px; padding: 4px;font: normal 10px/1 Verdana, Geneva, sans-serif;'>" + FirstLineEx + "</div>" + "</div>" _
+ "<div style=><img style='width:200px;margin:0 0 4px 0' src=" + sPrefix + "/" + sImageName + "></div>" + vbNewLine _
+ vbNewLine + "<div style='padding:0px;margin:0px;font-size:9px;'>" + NoteTextEx + "</div></div>" + vbNewLine + vbNewLine


Next oSlide


'Gem HTML filen
HTMLEx = StartHTML + TempHTML + EndHTML
Dim TextFile As Integer
Dim FilePath As String
'What is the file path and name for the new text file?
FilePath = sImagePath_old + "\" + sPrefix + ".html"
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file
Open FilePath For Output As TextFile
'Write some lines of text
Print #TextFile, HTMLEx
'Save & Close Text File
Close TextFile


End With







Err_ImageSave:
If Err <> 0 Then
MsgBox Err.Description
End If






End Sub







CEventClass:



Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)


Application.Run "Module1.OpdaterTid"


End Sub