Setting CUSTOM depth for 3-D objects!

[Xalamander]

Does anyone know why I do not get an option to set "custom" depth when
working with 3D objects? Under the "3-D Effects" button I get all the
general categories, and when I come down to "Depth" I get several preset
options (0 pt., 36 pt., 72 pt., 144 pt., 288 pt., and infinity). But there
is no option for setting "Custom" depth. I need to set my text at a depth
around 12 pt.

Can anyone tell me how and if it can be done?! Thank you immensely!

 

[CyberTaz]

I have a feeling the answer to your question requires at least 2 pieces of
information which you did not furnish - What version of Word & whether it's
a new document or one created in a previous version. Therefore one can only
guess...

You're working in Word 2007 & the doc was created in an earlier version or
vice-versa... Or maybe I'm totally off base. Post back with complete details
& someone will most likely be able to assist.

Regards |:>)
Bob Jones
[MVP] Office:Mac

 

[Xalamander]

First of all: Thank you for replying! I'm using the latest Word 2007 (with
SP1 installed) and am working on a brand new document (.docx) created with
Word 2007 (so no mixing of versions).

 

[Bob Buckland ?:-\)]

Hi Xalamander,

By oversight, the 'choose your own depth' (custom) choice was left out of the dialogs for Word 2007 in the 3D effects dropdown at
Drawing Tools=>Format=>3-D Effects=>Depth

You can use a macro to get the feature back and hopefully one of the MVPs who still do coding can turn this starter into something
complete/bettter <g>

(i.e. it doesn't check to see if you have a graphic selected, nor does it limit you to typing only numbers with up to 2 decimal
places, etc).


'=====Unfinished Starter Stub for 3dCustomDepth macro=====
Sub Custom3Ddepth()

Dim My3Ddepth As String
My3Ddepth = Selection.ShapeRange.ThreeD.Depth

My3Ddepth = Inputbox("Type a number to change 3D depth shown", _
"Change AutoShape 3D depth", My3Ddepth)

If My 3Ddepth <> "" Then
Selection.ShapeRange.ThreeD.Visible - msoTrue
Selection.ShapeRange.ThreeD.Depth = My3Ddepth
EndIf
End Sub
'===============

=====================
First of all: Thank you for replying! I'm using the latest Word 2007 (with
SP1 installed) and am working on a brand new document (.docx) created with
Word 2007 (so no mixing of versions). >>
--

Bob Buckland ?
MS Office System Products MVP

*Courtesy is not expensive and can pay big dividends*

 

[Tony Jollans]

Hi Chaps,

This isn't as easy as you might think. Well, it isn't so much that it's
difficult to actually do as it seems impossible to do it neatly through the
menus.

I don't believe it is possible (unless you use RibbonX to customize the
ribbon, and even then I'm not sure) to add the Custom Depth option to the
Ribbon popup/dropdown/gallery/whatever it's called.

The next best thing is to add it to the right click menu on the shape.
However all my attempts to add the Microsoft control to this have failed.
Adding the control is easy enough but it doesn't show up when you right
click the shape.

Further, all my attempts to add any type of control at all that takes input
have failed in the same way. The controls do get added to the menu and if
you pop up the menu (through code) when a shape is not selected they even
'work' (but not on any shape) but they do not appear properly when you right
click a shape.

So, what I have done is to add a simple button to the right click menu and
made it bring up an Input Box. I then pass the input from there to the
(otherwise unavailable through the UI) original built-in control.
I'm sorry to say that even this is not really good because if you type
nonsense you get the error message but must then right click again for
another try.

Maybe I'm being particularly thick about something and someone better and
bolder can come along with an improvement. Meanwhile ...

Add this code to your Normal Template. If you normally use a different
global template, that would be better, and if you do I'm sure you know how
to adapt the code. If, on the other hand, you know nothing of macros, see
http://www.gmayor.com/installing_macro.htm

Sub OneTimeSetUp()

With CommandBars("Shapes").Controls.Add(Type:=msoControlButton)
.Caption = "Custom Depth"
.OnAction = "MyCustomDepth"
.FaceId = 1379
End With

End Sub

Sub MyCustomDepth()

On Error GoTo Done
NewCustomDepth = InputBox("Please Enter New Custom Depth", _
"3-D Setting: Custom Depth", _
CommandBars.FindControl(ID:=1572).Text)

If NewCustomDepth <> "" Then
CommandBars.FindControl(ID:=1572).Text = NewCustomDepth
End If

Done: End Sub

Run the OneTimeSetUp macro once to add the extra control. You can then throw
it away. But keep the MyCustomDepth macro because that is the one that runs
when you click the new button.

The extra option on the Shapes menu will appear even when it's not valid
but the error trap should mean that nothing happens if you click on it.


[OK, Bob? <g>]

 

[Bob Buckland ?:-\)]

Hi Tony,

Thank you for the help. The barnacles on my macro skills would these days likely create more crashes than feature
enhancements/solutions beyond the conceptual <g> and I appreciate those of you with current skills in that area, as demonstrated
here frequently, from coming up with working solutions.

=============
<<"Tony Jollans" <My forename at my surname dot com> wrote in message Hi Chaps,

This isn't as easy as you might think. Well, it isn't so much that it's
difficult to actually do as it seems impossible to do it neatly through the
menus.

I don't believe it is possible (unless you use RibbonX to customize the
ribbon, and even then I'm not sure) to add the Custom Depth option to the
Ribbon popup/dropdown/gallery/whatever it's called.

The next best thing is to add it to the right click menu on the shape.
However all my attempts to add the Microsoft control to this have failed.
Adding the control is easy enough but it doesn't show up when you right
click the shape.

Further, all my attempts to add any type of control at all that takes input
have failed in the same way. The controls do get added to the menu and if
you pop up the menu (through code) when a shape is not selected they even
'work' (but not on any shape) but they do not appear properly when you right
click a shape.

So, what I have done is to add a simple button to the right click menu and
made it bring up an Input Box. I then pass the input from there to the
(otherwise unavailable through the UI) original built-in control.
I'm sorry to say that even this is not really good because if you type
nonsense you get the error message but must then right click again for
another try.

Maybe I'm being particularly thick about something and someone better and
bolder can come along with an improvement. Meanwhile ...

Add this code to your Normal Template. If you normally use a different
global template, that would be better, and if you do I'm sure you know how
to adapt the code. If, on the other hand, you know nothing of macros, see
http://www.gmayor.com/installing_macro.htm

Sub OneTimeSetUp()

With CommandBars("Shapes").Controls.Add(Type:=msoControlButton)
.Caption = "Custom Depth"
.OnAction = "MyCustomDepth"
.FaceId = 1379
End With

End Sub

Sub MyCustomDepth()

On Error GoTo Done
NewCustomDepth = InputBox("Please Enter New Custom Depth", _
"3-D Setting: Custom Depth", _
CommandBars.FindControl(ID:=1572).Text)

If NewCustomDepth <> "" Then
CommandBars.FindControl(ID:=1572).Text = NewCustomDepth
End If

Done: End Sub

Run the OneTimeSetUp macro once to add the extra control. You can then throw
it away. But keep the MyCustomDepth macro because that is the one that runs
when you click the new button.

The extra option on the Shapes menu will appear even when it's not valid
but the error trap should mean that nothing happens if you click on it.


[OK, Bob? <g>]

--
Enjoy,
Tony >>
--

Bob Buckland ?
MS Office Stuff MVP

*Courtesy is not expensive and can pay big dividends*

 

[Jay Freedman]

Hi Xalamander,

Bob shamed me into answering the call. ;-)

Sub Custom3DDepth()
Dim oShp As ShapeRange
Dim msg As String
Dim strCustomDepth As String
Dim sngCustomDepth As Single

' Get the shape object, or exit.
On Error Resume Next
Set oShp = Selection.ShapeRange
If Err.Number <> 0 Then
msg = Err.Description
MsgBox msg
Exit Sub
End If
On Error GoTo 0
If oShp.Count = 0 Then
msg = "Please select a shape."
MsgBox msg
Exit Sub
End If

' Ask the user for the custom depth.
' This would be better done with a
' UserForm, which would allow easier
' validation and re-entry, and a spinner control.
RetryEntry:
strCustomDepth = CStr(oShp.ThreeD.Depth)
strCustomDepth = InputBox("Enter custom depth in points:", , strCustomDepth)

If Trim(strCustomDepth) = "" Then
Exit Sub
End If

msg = "Please enter a valid number from -600 to 9600, or blank to quit."
If Not IsNumeric(strCustomDepth) Then
MsgBox msg
GoTo RetryEntry
End If

sngCustomDepth = CSng(strCustomDepth)
If (sngCustomDepth < -600#) Or (9600# < sngCustomDepth) Then
MsgBox msg
GoTo RetryEntry
End If

' Set the depth
oShp.ThreeD.Visible = msoTrue
oShp.ThreeD.Depth = CSng(strCustomDepth)
End Sub


As noted in one of the comments, it would be more user-friendly to equip the
macro with a UserForm instead of the InputBox. That would enable the UserForm to
verify on each keystroke that the user's entry is a valid numeric value in the
allowed range, and you could add a spinner control to let the user click to
increase or decrease the value.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so all
may benefit.