\u5404\u30b9\u30e9\u30a4\u30c9\u306b\u914d\u7f6e\u3055\u308c\u305f\u30aa\u30fc\u30c8\u30b7\u30a7\u30a4\u30d7\u304b\u3089\u30c6\u30ad\u30b9\u30c8\u3092\u629c\u304d\u51fa\u3059\u51e6\u7406\u3092\u8003\u3048\u3066\u307f\u307e\u3057\u305f\u3002<\/p>\n
Option Explicit\r\n\r\nPublic Sub Sample()\r\n Dim sld As PowerPoint.Slide\r\n Dim shp As PowerPoint.Shape\r\n Dim gshps As PowerPoint.GroupShapes\r\n Dim tmpsld As PowerPoint.Slide\r\n Dim tmpvt As PowerPoint.PpViewType\r\n \r\n If Application.SlideShowWindows.Count > 0& Then Exit Sub\r\n tmpvt = Application.ActiveWindow.ViewType\r\n Application.ActiveWindow.ViewType = ppViewNormal\r\n Set tmpsld = Application.ActivePresentation.Slides.FindBySlideID _\r\n (Application.ActivePresentation.Windows(1).Selection.SlideRange.SlideID)\r\n For Each sld In Application.ActivePresentation.Slides\r\n For Each shp In sld.Shapes\r\n Set gshps = Nothing\r\n On Error Resume Next\r\n Set gshps = shp.GroupItems\r\n On Error GoTo 0\r\n If gshps Is Nothing Then\r\n SortShape shp\r\n Else\r\n SortGroupShape gshps\r\n End If\r\n Next\r\n Next\r\n tmpsld.Select\r\n Application.ActiveWindow.ViewType = tmpvt\r\nEnd Sub\r\n\r\nPrivate Sub SortGroupShape(ByVal gshps As PowerPoint.GroupShapes)\r\n'\u30b0\u30eb\u30fc\u30d7\u5316\u3055\u308c\u305f\u30b7\u30a7\u30a4\u30d7\u306e\u632f\u308a\u5206\u3051\r\n Dim shp As PowerPoint.Shape\r\n Dim subgshps As PowerPoint.GroupShapes\r\n \r\n For Each shp In gshps\r\n Set subgshps = Nothing\r\n On Error Resume Next\r\n Set subgshps = shp.GroupItems\r\n On Error GoTo 0\r\n If subgshps Is Nothing Then\r\n SortShape shp\r\n Else\r\n SortGroupShape subgshps\r\n End If\r\n Next\r\nEnd Sub\r\n\r\nPrivate Sub SortShape(ByVal shp As PowerPoint.Shape)\r\n'\u30b7\u30a7\u30a4\u30d7\u306e\u632f\u308a\u5206\u3051\r\n Dim n As Office.SmartArtNode\r\n Dim clm As PowerPoint.Column\r\n Dim c As PowerPoint.Cell\r\n \r\n Select Case shp.Type\r\n Case msoSmartArt\r\n For Each n In shp.SmartArt.Nodes\r\n If n.TextFrame2.HasText = True Then MainProcSmartArtNode n\r\n Next\r\n Case msoTable\r\n For Each clm In shp.Table.Columns\r\n For Each c In clm.Cells\r\n If c.Shape.TextFrame.HasText = True Then MainProcShape c.Shape\r\n Next\r\n Next\r\n Case msoChart\r\n MainProcChart shp\r\n Case Else\r\n If shp.TextFrame.HasText = True Then MainProcShape shp\r\n End Select\r\nEnd Sub\r\n\r\nPrivate Sub MainProcShape(ByRef shp As PowerPoint.Shape)\r\n Debug.Print shp.Parent.Name, shp.TextFrame.TextRange.Text\r\nEnd Sub\r\n\r\nPrivate Sub MainProcSmartArtNode(ByRef nd As Office.SmartArtNode)\r\n Debug.Print nd.Parent.Name, nd.TextFrame2.TextRange.Text\r\nEnd Sub\r\n\r\nPrivate Sub MainProcChart(ByRef shp As PowerPoint.Shape)\r\n Dim r As Object\r\n \r\n On Error Resume Next\r\n shp.Parent.Select: DoEvents: shp.Select\r\n Application.CommandBars.ExecuteMso "ChartShowData"\r\n If Err.Number = 0 Then\r\n For Each r In shp.Chart.ChartData.Workbook.ActiveSheet.UsedRange\r\n Debug.Print shp.Parent.Name, r.Text\r\n Next\r\n shp.Chart.ChartData.Workbook.Close\r\n Else\r\n Debug.Print shp.Name & "\u306e\u30bb\u30eb\u5185\u5bb9\u306e\u53d6\u5f97\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002"\r\n End If\r\n On Error GoTo 0\r\nEnd Sub<\/pre>\n\u30aa\u30fc\u30c8\u30b7\u30a7\u30a4\u30d7\u306e\u7a2e\u985e\u306b\u3088\u3063\u3066\u30c6\u30ad\u30b9\u30c8\u306e\u629c\u304d\u51fa\u3057\u65b9\u304c\u7570\u306a\u308b\u305f\u3081\u3001\u3068\u308a\u3042\u3048\u305a\u3001\u30b9\u30de\u30fc\u30c8\u30a2\u30fc\u30c8\u3084\u30c6\u30fc\u30d6\u30eb\u3001\u30b0\u30e9\u30d5\u3001\u30b0\u30eb\u30fc\u30d7\u5316\u3055\u308c\u305f\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\u3082\u8003\u616e\u3057\u3066\u307f\u307e\u3057\u305f\u3002<\/p>\n
\u4e0a\u8a18\u30b3\u30fc\u30c9\u3067\u306fDebug.Print\u3067\u5358\u306b\u30a4\u30df\u30c7\u30a3\u30a8\u30a4\u30c8\u30a6\u30a3\u30f3\u30c9\u30a6\u306b\u6587\u5b57\u5217\u3092\u51fa\u529b\u3057\u3066\u3044\u308b\u3060\u3051\u306a\u306e\u3067\u3001\u53d6\u5f97\u3057\u305f\u6587\u5b57\u5217\u3092\u5916\u90e8\u306b\u4fdd\u5b58\u3059\u308b\u5834\u5408\u306fMainProc***\u306e\u5185\u5bb9\u3092\u5909\u66f4\u3059\u308b\u5fc5\u8981\u304c\u3042\u308a\u307e\u3059\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"\u5404\u30b9\u30e9\u30a4\u30c9\u306b\u914d\u7f6e\u3055\u308c\u305f\u30aa\u30fc\u30c8\u30b7\u30a7\u30a4\u30d7\u304b\u3089\u30c6\u30ad\u30b9\u30c8\u3092\u629c\u304d\u51fa\u3059\u51e6\u7406\u3092\u8003\u3048\u3066\u307f\u307e\u3057\u305f\u3002 Option Explicit Public Sub Sample() Dim sld As PowerPoint.Slide Dim s […]","protected":false},"author":1,"featured_media":7125,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[4,58],"tags":[90,91],"class_list":["post-2327","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-office","category-powerpoint","tag-powerpoint-vba","tag-powerpoint-"],"aioseo_notices":[],"aioseo_head":"\n\t\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t