Export 4K Video from Powerpoint

gistfile1.txt

Sub Export4KPowerpoint()
  If ActivePresentation.CreateVideoStatus <> ppMediaTaskStatusInProgress Then
    ActivePresentation.CreateVideo FileName:=Environ("USERPROFILE") & "\Desktop\export.mp4", _
    UseTimingsAndNarrations:=True, _
    VertResolution:=2160, _
    FramesPerSecond:=30, _
    Quality:=100
  Else: MsgBox "There is another conversion to video in progress"
  End If
End Sub