Article ID: 164515
Article Last Modified on 10/11/2006
APPLIES TO
- Microsoft PowerPoint 97 Standard Edition
This article was previously published under Q164515
SUMMARY
An add-in for PowerPoint 97 that allows you to rotate three-dimensional (3-D) objects in one-degree increments is available to download from the Microsoft Download Center:
This self-extracting file contains the following three files:
ThreeD.ppt
ThreeD.ppa
Readme.txt
For additional information about how to download Microsoft Support files, click the following article number to view the article in the Microsoft Knowledge Base:
119591 How to Obtain Microsoft Support Files from Online Services
Microsoft scanned this file for viruses. Microsoft used the most current virus-detection software that was available on the date that the file was posted. The file is stored on security-enhanced servers that help to prevent any unauthorized changes to the file.
MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.
Contents of the Readme.txt file
The following information is the complete text of the Readme.txt file:
------------------------ HOW TO USE THIS DOCUMENT ------------------------ To view the Readme.txt file, open it in Notepad. To print Readme.txt, open it in Notepad or another word processor, and then click Print on the File menu. -------- CONTENTS -------- - WHAT IS A POWERPOINT ADD-IN? - HOW TO LOAD THE ADD-IN - HOW TO USE THREED.PPA - THE SOURCE CODE - The Code in the Form - The Code in the Module - HOW TO REMOVE THE ADD-IN - SUPPORT AND INFORMATION WHAT IS A POWERPOINT ADD-IN? ============================ Add-ins are supplemental programs that extend the capabilities of PowerPoint by adding custom commands and specialized features. You can obtain add-ins from independent software vendors or you can write your own. HOW TO LOAD THE ADD-IN ====================== To use an add-in, you must first install it on your computer and then load it into PowerPoint. PowerPoint add-ins have the file name extension .ppa. To load the ThreeD.ppa add-in, use these steps: 1. Start PowerPoint. 2. On the Tools menu, click Add-Ins. 3. Click Add New. 4. In the Add New PowerPoint Add-In dialog box, select the ThreeD.ppa file and then click OK. 5. In the macro warning message box, click Enable Macros. NOTE: ThreeD.ppa contains macro code. Enable Macros must be selected for the add-in to run correctly. 6. Click Close. The ThreeD.ppa add-in is now loaded into PowerPoint. The 3-D Rotation command has been added to the Tools menu. HOW TO USE THREED.PPA ===================== By default, PowerPoint allows you to rotate objects in five-degree increments. The ThreeD.ppa add-in allows you to rotate three-dimensional (3-D) objects in one-degree increments. You cannot use this command to rotate one-dimensional (1-D) objects. To apply a 3-D effect to a 1-D object, use these steps: 1. Add a drawing object to a slide. 2. Select the object. 3. On the Drawing toolbar, click the 3-D button, and then click one of the 3-D styles. NOTE: If the 3-D styles are unavailable, you cannot apply a 3-D effect to the selected object, or you have not selected an object. To rotate the 3-D object in one-degree increments, using the 3-D Rotation command, use these steps: 1. Select a 3-D object. 2. On the Tools menu, click 3-D Rotation. 3. In the Rotate 3D Axis dialog box, type a value for the X, Y, and Z axes. The X, Y, and Z axes represent the height, width, and depth axes, respectively. 4. Optional: Click to select the Animate Rotation check box if you want to animate the object while the rotation effect is applied. NOTE: After the rotation effect is applied, the object will not continue to be animated. 5. Click Preview to see how the values affect the rotation of the object. NOTE: You can click Reset if you want to return the object to its original settings, or click Cancel to close the dialog box without making changes to the object. 6. Click OK to apply the values you set. THE SOURCE CODE =============== The Code in the Form -------------------- 'Define default axis variables, to store initial X,Y positions 'of the object being rotated. Dim defX As Integer Dim defY As Integer Dim defZ As Integer Dim objName As String 'Define variables used for rotation. Dim newX As Integer Dim newY As Integer Dim newZ As Integer 'Define variables used in error checking. Dim lastX As Integer Dim lastY As Integer Dim lastZ As Integer '-------------------------------------------------------------- ' Procedure: Cancelbut_Click() ' Arguments: none ' Description: Resets the object back to the original X-Y-Z ' coordinates and then unloads the form. '-------------------------------------------------------------- Private Sub Cancelbut_Click() ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = defX ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = defY ActiveWindow.Selection.ShapeRange.Rotation = defZ Unload Me End Sub '-------------------------------------------------------------- ' Procedure: cmdReset_Click() ' Arguments: none ' Description: Resets the object back to the original X-Y-Z ' coordinates and sets the axis of the text ' boxes back to their original values. '-------------------------------------------------------------- Private Sub cmdReset_Click() If chkFancy.Value = True Then newX = Xaxis.Value newY = Yaxis.Value newZ = Zaxis.Value FancyRot defX, defY, defZ Else ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = defX ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = defY ActiveWindow.Selection.ShapeRange.Rotation = defZ End If cmdReset.Enabled = False Xaxis.Value = defX Yaxis.Value = defY Zaxis.Value = defZ End Sub '-------------------------------------------------------------- ' Procedure: OKbut_Click() ' Arguments: none ' Description: Run RotMe subroutine and then unload ' the form. '-------------------------------------------------------------- Private Sub OKbut_Click() RotMe Unload Me End Sub '-------------------------------------------------------------- ' Procedure: preview_Click() ' Arguments: none ' Description: Runs RotMe so user can see if rotation is ' acceptable. '-------------------------------------------------------------- Private Sub preview_Click() RotMe cmdReset.Enabled = True End Sub '-------------------------------------------------------------- ' Procedure: SpinButton1_SpinDown() ' Arguments: none ' Description: Nudge down Y axis value. Make sure the axis ' value fits within boundry. '-------------------------------------------------------------- Private Sub SpinButton1_SpinDown() Yaxis.Value = Yaxis.Value - SpinButton1.SmallChange If Yaxis.Value < -90 Then Yaxis.Value = -90 End If End Sub '-------------------------------------------------------------- ' Procedure: SpinButton1_SpinUp() ' Arguments: none ' Description: Nudge up Y axis value. Check for bounds. '-------------------------------------------------------------- Private Sub SpinButton1_SpinUp() Yaxis.Value = Yaxis.Value + SpinButton1.SmallChange If Yaxis.Value > 90 Then Yaxis.Value = 90 End If End Sub '-------------------------------------------------------------- ' Procedure: SpinButton2_SpinDown() ' Arguments: none ' Description: Nudge down X axis value. Check for bounds. '-------------------------------------------------------------- Private Sub SpinButton2_SpinDown() Xaxis.Value = Xaxis.Value - SpinButton2.SmallChange If Xaxis.Value < -90 Then Xaxis.Value = -90 End If End Sub '-------------------------------------------------------------- ' Procedure: SpinButton2_SpinUp() ' Arguments: none ' Description: Nudge up X axis value. Check for bounds. '-------------------------------------------------------------- Private Sub SpinButton2_SpinUp() Xaxis.Value = Xaxis.Value + SpinButton2.SmallChange If Xaxis.Value > 90 Then Xaxis.Value = 90 End If End Sub '-------------------------------------------------------------- ' Procedure: SpinButton3_SpinDown() ' Arguments: none ' Description: Nudge down Z axis value. Check for bounds. '-------------------------------------------------------------- Private Sub SpinButton3_SpinDown() Zaxis.Value = Zaxis.Value - SpinButton3.SmallChange End Sub '-------------------------------------------------------------- ' Procedure: SpinButton3_SpinDown() ' Arguments: none ' Description: Nudge up Z axis value. Check for bounds. '-------------------------------------------------------------- Private Sub SpinButton3_SpinUp() Zaxis.Value = Zaxis.Value + SpinButton3.SmallChange End Sub '-------------------------------------------------------------- ' Procedure: UserForm_Activate() ' Arguments: none ' Description: Grab X, Y, Z axis coordinates for object. ' Set text boxes to same numbers. ' Set reserved variables. '-------------------------------------------------------------- Private Sub UserForm_Activate() defX = ActiveWindow.Selection.ShapeRange.ThreeD.RotationX defY = ActiveWindow.Selection.ShapeRange.ThreeD.RotationY If ActiveWindow.Selection.ShapeRange.Rotation > 180 Then defZ = ActiveWindow.Selection.ShapeRange.Rotation - 360 Else defZ = ActiveWindow.Selection.ShapeRange.Rotation End If Xaxis.Value = defX Yaxis.Value = defY Zaxis.Value = defZ lastX = defX lastY = defY lastZ = defZ objName = ActiveWindow.Selection.ShapeRange.Name cmdReset.Enabled = False End Sub '-------------------------------------------------------------- ' Procedure: RotMe() ' Arguments: none ' Description: Is the default rotation procedure. It checks ' to make sure that the object is in bounds. '-------------------------------------------------------------- Function RotMe() Dim x As Integer Dim y As Integer Dim z As Integer Dim i As Integer Dim k As Integer 'Is it Blank? 'yes, set to zero 'else set to axis value. On Error Resume Next Err.Clear If Xaxis.Value = "" Then x = 0 Xaxis.Value = x Else x = Xaxis.Value End If If Yaxis.Value = "" Then y = 0 Yaxis.Value = y Else y = Yaxis.Value End If If Zaxis.Value = "" Then z = 0 Zaxis.Value = z Else z = Zaxis.Value End If If Err.Number <> 0 Then MsgBox "Please enter a value between -90 and +90" Xaxis.Value = lastX Yaxis.Value = lastY Zaxis.Value = lastZ Else 'Is it bigger than 90? 'yes, then set it to 90 'no, is it less than -90 'yes, then set it to -90 If Xaxis.Value > 90 Then x = 90 Xaxis.Value = x Else If Xaxis.Value < -90 Then x = -90 Xaxis.Value = x End If End If If Yaxis.Value > 90 Then y = 90 Yaxis.Value = y Else If Yaxis.Value < -90 Then y = -90 Yaxis.Value = y End If End If If Zaxis.Value > 360 Then z = Zaxis.Value - 360 Zaxis.Value = z Else If Zaxis.Value < -360 Then z = Zaxis.Value + 360 Zaxis.Value = z End If End If 'Set axis to new location. If chkFancy.Value = True Then newX = ActiveWindow.Selection.ShapeRange.ThreeD.RotationX newY = ActiveWindow.Selection.ShapeRange.ThreeD.RotationY If ActiveWindow.Selection.ShapeRange.Rotation = lastZ Then newZ = ActiveWindow.Selection.ShapeRange.Rotation Else newZ = lastZ End If FancyRot x, y, z Else ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = y ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = x ActiveWindow.Selection.ShapeRange.Rotation = z End If lastX = x lastY = y lastZ = z End If End Function '-------------------------------------------------------------- ' Procedure: FancyRot() ' Arguments: [x] The new x coordinate. ' [y] The new y coordinate. ' [z] The new z coordinate. ' Description: Does the on-screen rotation animation. '-------------------------------------------------------------- Function FancyRot(x As Integer, y As Integer, z As Integer) Dim Ix As Integer Dim Iy As Integer Dim Iz As Integer Dim Kx As Integer Dim Ky As Integer Dim Kz As Integer 'Checks to see if current location, newX, is greater than 'or equal to x. If it's greater, set Kx to decrement the 'rotation loop by 1. Otherwise, increment the loop by 1. If newX >= x Then Kx = -1 Else Kx = 1 End If 'Checks to see if current location, newY, is greater than 'or equal to y. If it's greater, set Ky to decrement the 'rotation loop by 1. Otherwise, increment the loop by 1. If newY >= y Then Ky = -1 Else Ky = 1 End If 'Checks to see if current location, newZ, is greater than 'or equal to z. If it's greater, set Kz to decrement the 'rotation loop by 1. Otherwise, increment the loop by 1. If newZ >= z Then Kz = -1 Else Kz = 1 End If 'Loop through all three axes one at a time, and display 'the animation by selecting and deslecting the object. With ActiveWindow.Selection For Iy = newY To y Step Ky .SlideRange.Shapes(objName).Select .ShapeRange.ThreeD.RotationY = Iy .Unselect Next Iy For Ix = newX To x Step Kx .SlideRange.Shapes(objName).Select .ShapeRange.ThreeD.RotationX = Ix .Unselect Next Ix For Iz = newZ To z Step Kz .SlideRange.Shapes(objName).Select .ShapeRange.Rotation = Iz .Unselect Next Iz .SlideRange.Shapes(objName).Select End With End Function The Code in the Module ---------------------- '-------------------------------------------------------------- ' Procedure: LaunchRot() ' Arguments: none ' Description: Makes sure the selection is valid and then ' load the main form. '-------------------------------------------------------------- Sub LaunchRot() On Error Resume Next Err.Clear Dim not3d As Boolean 'Tests to see if the object selected is a shape If ActiveWindow.Selection.Type = ppSelectionShapes Then 'Check if error occured. If Err.Number <> 0 Then MsgBox "3-D Rotation requires that you have a " _ & "presentation open. Open a presentation, select " _ & "a 3-D object and run 3-D Rotation " _ & "again.", vbExclamation, "3-D Rotation Error" End End If 'Make sure that only one shape is selected. If ActiveWindow.Selection.ShapeRange.Count > 1 Then MsgBox "You have too many objects selected. 3-D Rotation " _ & Chr(13) & "requires that you select one 3-D object. To " _ & Chr(13) & "rotate more than one object at a time, use the Group" _ & Chr(13) & "command (Click Draw on the Drawing toolbar).", _ vbExclamation, "3-D Rotation Error" 'Stop the macro. End End If 'Tests to see if the object selected is a three-d shape. If ActiveWindow.Selection.ShapeRange.ThreeD.Visible = msoTrue Then 'Center the 3-D Rotation dialog box. frmRotMe.Top = ((Application.Height \ 2) - (frmRotMe.Height \ 2)) frmRotMe.Left = ((Application.Width \ 2) - (frmRotMe.Width \ 2)) 'Display the 3-D rotation form. frmRotMe.Show Else not3d = True End If End If MsgBox "Please choose a 3D object first.", _ vbExclamation, "No 3D Object Selected" End Sub '-------------------------------------------------------------- ' Procedure: Auto_Open() ' Arguments: none ' Description: This code is run when the Add-in is loaded. It ' Adds the 3-D Rotation command to the Tools ' menu. '-------------------------------------------------------------- Sub Auto_Open() 'Store an object reference to a command bar. Dim ToolsMenu As CommandBars 'Holds a reference to the new command. Dim NewControl As CommandBarControl 'Store the position of the control bar. Dim lPosition As Long Dim FoundFancy As Boolean 'Counter. Dim x As Long FoundFancy = False 'Figure out where to place the menu choice. Set ToolsMenu = Application.CommandBars 'Loop through the command bars. For x = 1 To ToolsMenu("Tools").Controls.Count With ToolsMenu("Tools").Controls.Item(x) 'Check if animation rotation is on the menu. If .Caption = "&3-D Rotation..." Then 'Animation rotation was found on the menu. FoundFancy = True If .OnAction = "LaunchRot" Then Exit For Else .OnAction = "LaunchRot" Exit For End If End If 'Place the command after the AutoClipart command. If .Caption = "A&utoClipArt..." Then Position = x + 1 Exit For End If End With Next x 'If the AutoClipArt command is not on the menu, place the command 'in the sixth position on the menu. If FoundFancy = False And Position = 0 Then Position = 6 End If If FoundFancy <> True And Position <> 0 Then 'Add the command to the menu. Set NewControl = ToolsMenu("Tools").Controls.Add _ (Type:=msoControlButton, _ Before:=Position) 'Name the command. NewControl.Caption = "&3-D Rotation..." 'Connect the command to the macro. NewControl.OnAction = "LaunchRot" End If End Sub '-------------------------------------------------------------- ' Procedure: Auto_Close() ' Arguments: none ' Description: Removes the 3-D Rotation command from the Tools menu. '-------------------------------------------------------------- Sub Auto_Close() 'Counter. Dim x As Long 'Store an object reference to a command bar. Dim ToolsMenu As CommandBars 'Figure out where to place the command. Set ToolsMenu = Application.CommandBars 'Loop through the command bars. For x = 1 To ToolsMenu("Tools").Controls.Count With ToolsMenu("Tools").Controls.Item(x) 'Check if Animation Rotation is on the menu. If .Caption = "&3-D Rotation..." Then 'Remove the command from the menu. .Delete End If End With Next x End Sub HOW TO REMOVE THE ADD-IN ======================== To conserve memory and increase the speed of PowerPoint, you can unload add-ins that you don't use frequently. When you unload an add-in, its features and commands are no longer available to PowerPoint, but the add-in remains on your computer for easy reloading. Use the following steps to unload ThreeD.ppa. 1. On the Tools menu, click Add-Ins. 2. Select the ThreeD add-in from the list of add-ins. 3. Click the Remove button. 4. Click Close. The 3-D Rotation command is removed from the Tools menu and the ThreeD.ppa add-in is removed from memory.
REFERENCES
For more information about getting help with Visual Basic for Applications, please see the following article in the Microsoft Knowledge Base:
163435 VBA: Programming Resources for Visual Basic for Applications
Additional query words: 97 kbpptvba ppa add in add-in
Keywords: kbdownload kbcode kbdtacode kbfile kbgraphxlink kbinfo kbmacro kbprogramming KB164515