ID: Q164515
The information in this article applies to:
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 Software Library (MSL):
~ three-d.exe (size: 75852 bytes)
75 KB self-extracting file
ThreeD.ppt
ThreeD.ppa
Readme.txt
ARTICLE-ID: Q119591
TITLE : How to Obtain Microsoft Support Files from Online
Services
Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft Support professionals 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 needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/refguide/default.asp
The following information is the complete text of the Readme.txt file:
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.
- The Code in the Form
- The Code in the Module
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.
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.
NOTE: ThreeD.ppa contains macro code. Enable Macros must be selected
for the add-in to run correctly.
The ThreeD.ppa add-in is now loaded into PowerPoint. The 3-D Rotation command has been added to the Tools menu.
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.
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.
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.
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.
'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.
'--------------------------------------------------------------
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
'--------------------------------------------------------------
' 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.
'--------------------------------------------------------------
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
'--------------------------------------------------------------
' 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
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.
For more information about getting help with Visual Basic for Applications, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q163435
TITLE : VBA: Programming Resources for Visual Basic for
Applications
Keywords : kbcode kbmacro kbprg kbdta kbdtacode kbpptvba
Version : WINDOWS:97
Platform : WINDOWS
Hardware : x86
Issue type : kbinfoLast Reviewed: May 17, 1999