Const px_to_cm As Long = 72/2.54
Const excp_str_len As Long = 5
Const excp_str As String = "_excp"

Sub AddNombre()

	'仮ノンブルを全ページに挿入するマクロです．
	
	Dim x, y, w, h, font_size As Long
	Dim font_en, font_ja, pretext, posttext As String
	
	'==============================
	'設定
	x = 23  '左がゼロ（単位はcm）
	y = 18  '最上部がゼロ，プラスの値でテキストボックスが下に沈んでいく（単位はcm）
	w = 5  'テキストボックスの幅
	h = 2  'テキストボックスの高さ
	font_en = "Arial"  '半角英数フォント名
	font_ja = "メイリオ"  '日本語フォント名
	font_size = 15  'フォントサイズ
	pretext = "仮ノンブル："  'ノンブルの接頭辞
	posttext = ""  'ノンブルの接尾辞
	'==============================

	Call DeleteNombre

	Dim i As Long
	Dim tb As Shape

	Dim k As Long
	k = 1

	For i = 1 To ActivePresentation.Slides.Count
		ActiveWindow.View.GotoSlide Index:=i
		With ActiveWindow.Selection.SlideRange
			If Len(.Name) >= excp_str_len And Right(.Name, excp_str_len) = excp_str Then GoTo CONTINUE_LABEL
		End With
		
		Set tb = ActivePresentation.Slides(i).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=x * px_to_cm, Top:=y * px_to_cm, Width:=w * px_to_cm, Height:=h * px_to_cm)
		With tb
			.Name = "Nombre"  'DeleteNombreサブルーチン用に追加するテキストボックスにはNombreという名前を付けておく
			.TextFrame.TextRange = pretext & k & posttext
			.TextFrame.TextRange.Font.Name = font_en
			.TextFrame.TextRange.Font.NameFarEast = font_ja
			.TextEffect.FontSize = font_size
		End With
		k = k + 1
		
CONTINUE_LABEL:
	Next i

	ActiveWindow.View.GotoSlide Index:=1
	MsgBox "ノンブルを更新しました．"

End Sub


Sub DeleteNombre()

	'Nombreという名前の任意のテキストボックスを削除するマクロです．

	With ActivePresentation
		For i = 1 To .Slides.Count
			For Each s In .Slides(i).Shapes
				If s.Name = "Nombre" Then s.Delete
			Next s
		Next i
	End With

End Sub


Sub Exclude()

	With ActiveWindow.Selection
		If .Type = ppSelectionNone Then Exit Sub
		For Each s In .SlideRange
			If Len(s.Name) < excp_str_len Or Right(s.Name, excp_str_len) <> excp_str Then s.Name = s.Name & excp_str
		Next s
	End With

	MsgBox "スライドを除外設定しました．"

End Sub


Sub Include()

	With ActiveWindow.Selection
		If .Type = ppSelectionNone Then Exit Sub
		For Each s In .SlideRange
			If Len(s.Name) >= excp_str_len And Right(s.Name, excp_str_len) = excp_str Then s.Name = Mid(s.Name, 1, Len(s.Name) - excp_str_len)
		Next s
	End With

	MsgBox "スライドの除外設定を解除しました．"

End Sub


Sub IncludeAll()

	ActivePresentation.Slides.Range.Select
	Call Include

End Sub


Sub Coordinate()

	Dim l, t As Long

	l = ActiveWindow.Selection.ShapeRange.Left
	t = ActiveWindow.Selection.ShapeRange.Top

	MsgBox "(" & l & ", " & t & ")"

End Sub