PowerPoint (全般)

PowerPoint 全般に関する話題を扱うフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Mac OS X : PowerPoint 2016)
スライドをランダム表示
投稿日時: 17/12/10 14:23:18
投稿者: pochipochi777

よろしくお願いいたします。
 
一つ前のスレッドに関連する質問をさせていただきましたが,同一内のスライドではなく,スライドごとに画像を貼り付けてランダム表示というように発想を変えてみました。
 
検索してみましたところいくつかのコードを見つけることができました。
 
そのうち以下のコードはまずPowerPoint 2017 for Mac OS10.13.2 で正常に動きました。正常というのは「3枚のスライド」がランダムに表示されたという意味です。これを任意の繰り返し数を手入力して,そして,ランダム表示させたいと思います。
 
引用サイト(ht tp://www.relief.jp/docs/017758.html
 
ExcelではInputBoxがあり,そこに数値を入力して,任意の数だけ実行できると思うのですが,PowerPoint no
VBAは本当に素人同然のため,行き詰まっています(Excelも似たようなレベルです)。ぜひご教示していただけませんでしょうか。
 
Sub ランダムにスライドを表示するスライドショー()
 
 Const ssTitle As String = "ランダムスライドショー"
 
 Dim cnt As Long
 Dim flg() As Boolean
 Dim sld() As Variant
 Dim num As Long
 Dim i As Long
 Dim ss As NamedSlideShow
 
 With ActivePresentation
 
  cnt = .Slides.Count
  ReDim flg(1 To cnt)
  ReDim sld(1 To cnt)
 
  Randomize
  For i = 1 To cnt
   Do
    num = Int(Rnd * cnt) + 1
    If flg(num) = False Then
     flg(num) = True
     sld(i) = .Slides.Item(num).SlideID
     Exit Do
    End If
   Loop
  Next i
 
  With .SlideShowSettings
   For Each ss In .NamedSlideShows
    If ss.Name = ssTitle Then
     .NamedSlideShows(ssTitle).Delete
     Exit For
    End If
   Next
 
   .RangeType = ppShowNamedSlideShow
   .NamedSlideShows.Add ssTitle, sld
   .SlideShowName = ssTitle
   .Run
  End With
 
 End With
 
End Sub

投稿日時: 17/12/10 14:34:47
投稿者: pochipochi777

申し訳ございません。もう一つ追加させてください。
 
「エスケープキーが押されるまで延々と繰り返し」も「任意の数字を手入力」と一緒にご教授願えますでしょうか。
 
よろしくお願いいたします。

回答
投稿日時: 17/12/10 16:01:13
投稿者: んなっと

ランダムだから「繰り返し」という表現はおかしいですよね。
ランダムで30回表示。
 
  Const ssTitle As String = "ランダムスライドショー"
  Dim cnt
  Dim sld() As Variant
  Dim num As Long
  Dim i As Long
  Dim ss As NamedSlideShow
  cnt = InputBox("回数", "表示スライド数", 30)
  If StrPtr(cnt) = 0 Then Exit Sub
  With ActivePresentation
    ReDim sld(1 To cnt)
    Randomize
    For i = 1 To cnt
      sld(i) = .Slides.Item(Int(Rnd * .Slides.Count) + 1).SlideID
    Next i
    With .SlideShowSettings
      On Error Resume Next
      .NamedSlideShows(ssTitle).Delete
      On Error GoTo 0
      .NamedSlideShows.Add ssTitle, sld
      .RangeType = ppShowNamedSlideShow
      .SlideShowName = ssTitle
      .Run
    End With

投稿日時: 17/12/10 16:18:57
投稿者: pochipochi777

んなっと様
 
お時間を取らせてしまい申し訳ございません。無事,考えた動作ができました。
 
本当にありがとうございました。