Guest User

Untitled

a guest
Mar 23rd, 2018
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.17 KB | None | 0 0
  1. Dim sld As slide, sh As Shape, cursh As Shape, cursh2 As Shape
  2.  
  3. Set sh = ActiveWindow.Selection.ShapeRange(1)
  4. 'Do something
  5.  
  6. Set cursh = ActiveWindow.Selection.ShapeRange(2)
  7. cursh.textFrame.TextRange.Copy
  8.  
  9. Set sld = Application.ActiveWindow.View.slide
  10. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  11. Left:=50, Top:=50, Width:=500, Height:=50)
  12.  
  13. sh.textFrame.TextRange.PasteSpecial ppPasteText
  14. sh.Line.Visible = msoFalse
  15.  
  16. cursh.Delete
  17.  
  18. Set cursh2 = ActiveWindow.Selection.ShapeRange(3)
  19. cursh.textFrame.TextRange.Copy
  20.  
  21. Set sld = Application.ActiveWindow.View.slide
  22. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  23. Left:=50, Top:=50, Width:=500, Height:=50)
  24.  
  25. sh.textFrame.TextRange.PasteSpecial ppPasteText
  26. sh.Line.Visible = msoFalse
  27.  
  28. cursh.Delete
  29.  
  30. Sub Select_SlideTitle_Only2()
  31.  
  32. 'Note: Set sh = ActiveWindow.Selection.ShapeRange(1)(To use for selecting active shape
  33.  
  34. Dim sld As slide, sh As Shape, cursh As Shape, cursh2 As Shape
  35. Dim Tbl As Table, myRow As Long, myCol As Long
  36. Dim myWidthST As Long, myHeightST As Long, myTopST As Long, myLeftST As Long, myFontST As String, myCNFontST As String, myFontsizeST As Long, myFontcolorST As String, _
  37. myMarginST As Long, myShapenameST As String, myVerticalAlignmentST As String, myBulletST As String, myBoldST As String, myAlignmentST As String
  38.  
  39. 'Define for Message
  40. Dim myWidthMT As Long, myHeightMT As Long, myTopMT As Long, myLeftMT As Long, myFontMT As String, myCNFontMT As String, myFontsizeMT As Long, myFontcolorMT As String, _
  41. myMarginMT As Long, myShapenameMT As String, myVerticalAlignmentMT As String, myBulletMT As String, myBoldMT As String, myAlignmentMT As String
  42. 'Select textbox, place them on itx designated location and name it "Messagebox" with margin as zero
  43.  
  44. 'Define for source formatting
  45. Dim myWidthS As Long, myHeightS As Long, myTopS As Long, myLeftS As Long, myFontS As String, myCNFontS As String, myFontsizeS As Long, myFontcolorS As String, _
  46. myMarginS As Long, myShapenameS As String, myVerticalAlignmentS As String, myBulletS As String, myBoldS As String, myAlignmentS As String
  47.  
  48.  
  49. 'Select textbox and turn the textbox to Frutiger 55 Roman formatting with margin all around as zero
  50.  
  51. myFontST = "Frutiger 45 Light"
  52. myFontsizeST = 28
  53. myWidthST = 723.6
  54. myHeightST = 74.16
  55. myTopST = 0.0002362005
  56. myLeftST = 33.12
  57. myMarginST = 0
  58. myShapenameST = "PAGE HEADING"
  59. myVerticalAlignmentST = msoAnchorBottom
  60.  
  61. Dim x As Long
  62. x = InputBox("Please enter a number for format. 1 = Title only, 2 = Title + Message, 3 = Title + Message + Source(Left Btm, 4 = Slide title + Message + Source(Center bottom)", "Gerald Slide Title Formatting")
  63.  
  64. Select Case x
  65.  
  66. Case Is = 1
  67.  
  68. Set sh = ActiveWindow.Selection.ShapeRange(1)
  69.  
  70. With sh
  71. .Width = myWidthST
  72. .Height = myHeightST
  73. .Top = myTopST
  74. .Left = myLeftST
  75. .Fill.Visible = msoFalse
  76. .Name = myShapenameST
  77. End With
  78.  
  79. With sh.textFrame.TextRange.ParagraphFormat
  80. .Alignment = ppAlignLeft
  81. .Bullet = msoFalse
  82. End With
  83.  
  84. With sh.textFrame.TextRange.Font
  85. .Name = myFontST
  86. .Size = myFontsizeST
  87. .Bold = msoFalse
  88. End With
  89.  
  90. With sh.textFrame
  91. .MarginLeft = myMarginST
  92. .MarginRight = myMarginST
  93. .MarginBottom = myMarginST
  94. .MarginTop = myMarginST
  95. .VerticalAnchor = myVerticalAlignmentST
  96. End With
  97.  
  98. Case Is = 2
  99.  
  100. 'Slide Title
  101. myFontST = "Frutiger 45 Light"
  102. myFontsizeST = 28
  103. myWidthST = 723.6
  104. myHeightST = 74.16
  105. myTopST = 0.0002362005
  106. myLeftST = 33.12
  107. myMarginST = 0
  108. myShapenameST = "PAGE HEADING"
  109. myVerticalAlignmentST = msoAnchorBottom
  110.  
  111. Set sh = ActiveWindow.Selection.ShapeRange(1)
  112.  
  113. With sh
  114. .Width = myWidthST
  115. .Height = myHeightST
  116. .Top = myTopST
  117. .Left = myLeftST
  118. .Fill.Visible = msoFalse
  119. .Name = myShapenameST
  120. End With
  121.  
  122. With sh.textFrame.TextRange.ParagraphFormat
  123. .Alignment = ppAlignLeft
  124. .Bullet = msoFalse
  125. End With
  126.  
  127. With sh.textFrame.TextRange.Font
  128. .Name = myFontST
  129. .Size = myFontsizeST
  130. .Bold = msoFalse
  131. End With
  132.  
  133. With sh.textFrame
  134. .MarginLeft = myMarginST
  135. .MarginRight = myMarginST
  136. .MarginBottom = myMarginST
  137. .MarginTop = myMarginST
  138. .VerticalAnchor = myVerticalAlignmentST
  139. End With
  140.  
  141. 'Message Text
  142.  
  143. myFontMT = "UBSHeadline"
  144. myFontsizeMT = 14
  145. myFontcolorMT = RGB(70, 71, 73)
  146. myWidthMT = 723.6
  147. myHeightMT = 21.6
  148. myTopMT = 85.5
  149. myLeftMT = 33.12
  150. myBoldMT = msoFalse
  151. myMarginMT = 0
  152. myShapenameMT = "MESSAGE TEXT"
  153. myVerticalAlignmentMT = msoAnchorTop
  154.  
  155. Set cursh = ActiveWindow.Selection.ShapeRange(2)
  156. cursh.textFrame.TextRange.Copy
  157.  
  158. Set sld = Application.ActiveWindow.View.slide
  159. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  160. Left:=50, Top:=50, Width:=150, Height:=50) 'this shape will now be called sh
  161.  
  162. sh.textFrame.TextRange.PasteSpecial ppPasteText
  163. sh.Line.Visible = msoFalse 'remove border
  164.  
  165. cursh.Delete 'Delete the selected shape
  166.  
  167. With sh
  168. .Width = myWidthMT
  169. .Height = myHeightMT
  170. .Top = myTopMT
  171. .Left = myLeftMT
  172. .Name = myShapenameMT
  173. .Fill.Visible = msoFalse
  174. End With
  175.  
  176. With sh.textFrame.TextRange.ParagraphFormat
  177. .Alignment = ppAlignLeft
  178. .Bullet = msoFalse
  179. End With
  180.  
  181. With sh.textFrame.TextRange.Font
  182. .Name = myFontMT
  183. .Size = myFontsizeMT
  184. .Bold = myBoldMT
  185. .Color.RGB = myFontcolorMT
  186. End With
  187.  
  188. With sh.textFrame
  189. .MarginLeft = myMarginMT
  190. .MarginRight = myMarginMT
  191. .MarginBottom = myMarginMT
  192. .MarginTop = myMarginMT
  193. .VerticalAnchor = myVerticalAlignmentMT
  194. End With
  195.  
  196.  
  197.  
  198.  
  199. Case Is = 3
  200.  
  201. 'Slide Title
  202.  
  203. myFontST = "Frutiger 45 Light"
  204. myFontsizeST = 28
  205. myWidthST = 723.6
  206. myHeightST = 74.16
  207. myTopST = 0.0002362005
  208. myLeftST = 33.12
  209. myMarginST = 0
  210. myShapenameST = "PAGE HEADING"
  211. myVerticalAlignmentST = msoAnchorBottom
  212.  
  213. Set sh = ActiveWindow.Selection.ShapeRange(1)
  214.  
  215. With sh
  216. .Width = myWidthST
  217. .Height = myHeightST
  218. .Top = myTopST
  219. .Left = myLeftST
  220. .Fill.Visible = msoFalse
  221. .Name = myShapenameST
  222. End With
  223.  
  224. With sh.textFrame.TextRange.ParagraphFormat
  225. .Alignment = ppAlignLeft
  226. .Bullet = msoFalse
  227. End With
  228.  
  229. With sh.textFrame.TextRange.Font
  230. .Name = myFontST
  231. .Size = myFontsizeST
  232. .Bold = msoFalse
  233. End With
  234.  
  235. With sh.textFrame
  236. .MarginLeft = myMarginST
  237. .MarginRight = myMarginST
  238. .MarginBottom = myMarginST
  239. .MarginTop = myMarginST
  240. .VerticalAnchor = myVerticalAlignmentST
  241. End With
  242.  
  243. 'Message Text
  244.  
  245. myFontMT = "UBSHeadline"
  246. myFontsizeMT = 14
  247. myFontcolorMT = RGB(70, 71, 73)
  248. myWidthMT = 723.6
  249. myHeightMT = 21.6
  250. myTopMT = 85.5
  251. myLeftMT = 33.12
  252. myBoldMT = msoFalse
  253. myMarginMT = 0
  254. myShapenameMT = "MESSAGE TEXT"
  255. myVerticalAlignmentMT = msoAnchorTop
  256.  
  257. Set cursh = ActiveWindow.Selection.ShapeRange(2)
  258. cursh.textFrame.TextRange.Copy
  259.  
  260. Set sld = Application.ActiveWindow.View.slide
  261. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  262. Left:=50, Top:=50, Width:=150, Height:=50) 'this shape will now be called sh
  263.  
  264. sh.textFrame.TextRange.PasteSpecial ppPasteText
  265. sh.Line.Visible = msoFalse 'remove border
  266.  
  267.  
  268.  
  269. With sh
  270. .Width = myWidthMT
  271. .Height = myHeightMT
  272. .Top = myTopMT
  273. .Left = myLeftMT
  274. .Name = myShapenameMT
  275. .Fill.Visible = msoFalse
  276. End With
  277.  
  278. With sh.textFrame.TextRange.ParagraphFormat
  279. .Alignment = ppAlignLeft
  280. .Bullet = msoFalse
  281. End With
  282.  
  283. With sh.textFrame.TextRange.Font
  284. .Name = myFontMT
  285. .Size = myFontsizeMT
  286. .Bold = myBoldMT
  287. .Color.RGB = myFontcolorMT
  288. End With
  289.  
  290. With sh.textFrame
  291. .MarginLeft = myMarginMT
  292. .MarginRight = myMarginMT
  293. .MarginBottom = myMarginMT
  294. .MarginTop = myMarginMT
  295. .VerticalAnchor = myVerticalAlignmentMT
  296. End With
  297.  
  298. 'Source Left full
  299.  
  300. myFontsizeS = 8
  301. myWidthS = 723.6
  302. myHeightS = 15.12
  303. myTopS = 505.38
  304. myLeftS = 33.12
  305. myMarginS = 0
  306. myAlignmentS = ppAlignLeft
  307. myBulletS = msoFalse
  308. myVerticalAlignmentS = msoAnchorBottom
  309. myShapenameS = "SourceText"
  310. myFontcolorS = RGB(0, 0, 0)
  311.  
  312. Set cursh2 = ActiveWindow.Selection.ShapeRange(3)
  313. cursh2.textFrame.TextRange.Copy
  314.  
  315. Set sld = Application.ActiveWindow.View.slide
  316. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  317. Left:=50, Top:=50, Width:=150, Height:=50) 'this shape will now be called sh
  318.  
  319. sh.textFrame.TextRange.PasteSpecial ppPasteText
  320. sh.Line.Visible = msoFalse 'remove border
  321.  
  322. cursh2.Delete 'Delete the selected shape
  323.  
  324. With sh
  325. .Width = myWidth
  326. .Height = myHeight
  327. .Top = myTop
  328. .Left = myLeft
  329. .Fill.Visible = msoFalse
  330. .Name = myShapename
  331. End With
  332.  
  333. With sh.textFrame.TextRange.ParagraphFormat
  334. .Alignment = myAlignment
  335. .Bullet = myBullet
  336. End With
  337.  
  338. With sh.textFrame.TextRange.Font
  339. .Name = myFont
  340. .Size = myFontsize
  341. .Bold = msoFalse
  342. .Color.RGB = myFontcolor
  343. End With
  344.  
  345. With sh.textFrame
  346. .MarginLeft = myMargin: .MarginRight = myMargin: .MarginBottom = myMargin: .MarginTop = myMargin
  347. .VerticalAnchor = myVerticalAlignment
  348. End With
  349.  
  350. With sh.textFrame.Ruler
  351. .TabStops.Add ppTabStopLeft, 30
  352. .TabStops.Add ppTabStopLeft, 13
  353. End With
  354.  
  355. Case Is = 4
  356.  
  357. myFontST = "Frutiger 45 Light"
  358. myFontsizeST = 28
  359. myWidthST = 723.6
  360. myHeightST = 74.16
  361. myTopST = 0.0002362005
  362. myLeftST = 33.12
  363. myMarginST = 0
  364. myShapenameST = "PAGE HEADING"
  365. myVerticalAlignmentST = msoAnchorBottom
  366.  
  367. Set sh = ActiveWindow.Selection.ShapeRange(1)
  368.  
  369. With sh
  370. .Width = myWidthST
  371. .Height = myHeightST
  372. .Top = myTopST
  373. .Left = myLeftST
  374. .Fill.Visible = msoFalse
  375. .Name = myShapenameST
  376. End With
  377.  
  378. With sh.textFrame.TextRange.ParagraphFormat
  379. .Alignment = ppAlignLeft
  380. .Bullet = msoFalse
  381. End With
  382.  
  383. With sh.textFrame.TextRange.Font
  384. .Name = myFontST
  385. .Size = myFontsizeST
  386. .Bold = msoFalse
  387. End With
  388.  
  389. With sh.textFrame
  390. .MarginLeft = myMarginST
  391. .MarginRight = myMarginST
  392. .MarginBottom = myMarginST
  393. .MarginTop = myMarginST
  394. .VerticalAnchor = myVerticalAlignmentST
  395. End With
  396.  
  397. 'Message Text
  398.  
  399. myFontMT = "UBSHeadline"
  400. myFontsizeMT = 14
  401. myFontcolorMT = RGB(70, 71, 73)
  402. myWidthMT = 723.6
  403. myHeightMT = 21.6
  404. myTopMT = 85.5
  405. myLeftMT = 33.12
  406. myBoldMT = msoFalse
  407. myMarginMT = 0
  408. myShapenameMT = "MESSAGE TEXT"
  409. myVerticalAlignmentMT = msoAnchorTop
  410.  
  411. Set cursh = ActiveWindow.Selection.ShapeRange(2)
  412. cursh.textFrame.TextRange.Copy
  413.  
  414. Set sld = Application.ActiveWindow.View.slide
  415. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  416. Left:=50, Top:=50, Width:=150, Height:=50) 'this shape will now be called sh
  417.  
  418. sh.textFrame.TextRange.PasteSpecial ppPasteText
  419. sh.Line.Visible = msoFalse 'remove border
  420.  
  421. cursh.Delete 'Delete the selected shape
  422.  
  423. With sh
  424. .Width = myWidthMT
  425. .Height = myHeightMT
  426. .Top = myTopMT
  427. .Left = myLeftMT
  428. .Name = myShapenameMT
  429. .Fill.Visible = msoFalse
  430. End With
  431.  
  432. With sh.textFrame.TextRange.ParagraphFormat
  433. .Alignment = ppAlignLeft
  434. .Bullet = msoFalse
  435. End With
  436.  
  437. With sh.textFrame.TextRange.Font
  438. .Name = myFontMT
  439. .Size = myFontsizeMT
  440. .Bold = myBoldMT
  441. .Color.RGB = myFontcolorMT
  442. End With
  443.  
  444. With sh.textFrame
  445. .MarginLeft = myMarginMT
  446. .MarginRight = myMarginMT
  447. .MarginBottom = myMarginMT
  448. .MarginTop = myMarginMT
  449. .VerticalAnchor = myVerticalAlignmentMT
  450. End With
  451.  
  452.  
  453. 'Source Bottom center full
  454.  
  455. myFontsizeS = 8
  456. myFontcolorS = RGB(0, 0, 0)
  457. myWidthS = 617.47
  458. myHeightS = 19.17
  459. myTopS = 551.9857
  460. myLeftS = 125.0239
  461. myMarginS = 0
  462. myAlignmentS = ppAlignLeft
  463.  
  464. myBulletS = msoFalse
  465. myVerticalAlignmentS = msoAnchorMiddle
  466. myShapenameS = "SourceText"
  467. myFontcolorS = RGB(0, 0, 0)
  468.  
  469. Set cursh2 = ActiveWindow.Selection.ShapeRange(3)
  470. cursh2.textFrame.TextRange.Copy
  471.  
  472. Set sld = Application.ActiveWindow.View.slide
  473. Set sh = sld.shapes.AddShape(Type:=msoShapeRectangle, _
  474. Left:=50, Top:=50, Width:=150, Height:=50) 'this shape will now be called sh
  475.  
  476. sh.textFrame.TextRange.PasteSpecial ppPasteText
  477. sh.Line.Visible = msoFalse 'remove border
  478.  
  479. cursh2.Delete 'Delete the selected shape
  480.  
  481. With sh
  482. .Width = myWidth
  483. .Height = myHeight
  484. .Top = myTop
  485. .Left = myLeft
  486. .Fill.Visible = msoFalse
  487. .Name = myShapename
  488. End With
  489.  
  490. With sh.textFrame.TextRange.ParagraphFormat
  491. .Alignment = myAlignment
  492. .Bullet = myBullet
  493. End With
  494.  
  495. With sh.textFrame.TextRange.Font
  496. .Name = myFont
  497. .Size = myFontsize
  498. .Color.RGB = myFontcolor
  499. End With
  500.  
  501. With sh.textFrame
  502. .MarginLeft = myMargin: .MarginRight = myMargin: .MarginBottom = myMargin: .MarginTop = myMargin
  503. .VerticalAnchor = myVerticalAlignment
  504. End With
  505.  
  506. With sh.textFrame.Ruler
  507. .TabStops.Add ppTabStopLeft, 30
  508. .TabStops.Add ppTabStopLeft, 13
  509. End With
  510.  
  511. Case Else
  512. MsgBox ("You have not selected any shape, please try again")
  513.  
  514. End Select
  515.  
  516.  
  517.  
  518. End Sub
Add Comment
Please, Sign In to add comment