Solved

Add transparency to a Powerpoint macro command

Posted on 2013-12-18
10
675 Views
Last Modified: 2013-12-23
I am using a Powerpoint macro and I would like to add a 90% transparency to this (90% opaque) any ideas?

With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
End With 

Open in new window

0
Comment
Question by:cssoftware
  • 5
  • 3
  • 2
10 Comments
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39729020
Hi,

Maybe

With oTB
   .ShapeRange.Fill.Transparency = 0.9
End With

Open in new window

Regards
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39729852
90%% tranparent is not the same as 90% opaque but maybe:

With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
.Fill.Transparency = 0.9

End With
0
 

Author Comment

by:cssoftware
ID: 39729910
I added it here and got this error Method or Data Member not found,
With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
.ShapeRange.Fill.Transparency = 0.9
End With

Open in new window



then I tried adding it after like this , and that didn't work either, asme error message
With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
.ShapeRange.Fill.Transparency = 0.9
End With
With oTB
   .ShapeRange.Fill.Transparency = 0.9
End With

Open in new window

0
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 
LVL 23

Expert Comment

by:JSRWilson
ID: 39729990
How did you declare and set oTB??

I was assuming something like:
Dim oTB As Shape
Set oTB = ActiveWindow.Selection.SlideRange(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 200, 20)
With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = "whatever"
.Fill.ForeColor.RGB = vbWhite
.Fill.Transparency = 0.9
End With 

Open in new window

0
 

Author Comment

by:cssoftware
ID: 39730771
Thanks for your help!! This is the complete macro, I am adding text to images with a white background so it will be visible, and thought having a slight transparency would be even nicer:
Sub ImportABunchWithTextFromFile()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim picDesc() As String
Dim oSld As slide
Dim oPic As Shape
Dim oTB As Shape
Dim SW As Long
Dim SH As Long
Dim fs As Object
Dim f As Object
SW = ActivePresentation.PageSetup.SlideWidth
SH = ActivePresentation.PageSetup.SlideHeight
strPath = ActivePresentation.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(strPath & "\book1.txt", 1, 0)
Do While f.AtEndOfStream <> True
picDesc = Split(f.readline, Chr(9))
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=picDesc(0), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0)
Set oTB = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=SW * 0.1, _
Top:=SH * 0.8, _
Width:=SW * 0.8, _
Height:=SH * 0.2)

With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
End With

With oPic
.LockAspectRatio = msoTrue
If oPic.Width / oPic.Height > SW / SH Then
.Width = SW
.Top = (SH - oPic.Height) / 2
Else
.Height = SH
.Left = (SW - oPic.Width) / 2
End If
End With
Loop
End Sub

Open in new window

0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39731169
Hi,

pls try

Sub ImportABunchWithTextFromFile()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim picDesc() As String
Dim oSld As slide
Dim oPic As Shape
Dim oTB As Shape
Dim SW As Long
Dim SH As Long
Dim fs As Object
Dim f As Object
SW = ActivePresentation.PageSetup.SlideWidth
SH = ActivePresentation.PageSetup.SlideHeight
strPath = ActivePresentation.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(strPath & "\book1.txt", 1, 0)
Do While f.AtEndOfStream <> True
picDesc = Split(f.readline, Chr(9))
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=picDesc(0), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0)
Set oTB = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=SW * 0.1, _
Top:=SH * 0.8, _
Width:=SW * 0.8, _
Height:=SH * 0.2)

With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = picDesc(1)
.Fill.ForeColor.RGB = vbWhite
.Fill.Transparency = 0.9
End With

With oPic
.LockAspectRatio = msoTrue
If oPic.Width / oPic.Height > SW / SH Then
.Width = SW
.Top = (SH - oPic.Height) / 2
Else
.Height = SH
.Left = (SW - oPic.Width) / 2
End If
End With
Loop
End Sub

Open in new window

0
 

Author Comment

by:cssoftware
ID: 39733472
That was perfect, if I could ask you one more thing! The macro adds quotation marks around the text in the last two slides (I use 6 slides so it is 5 and 6) I tried to decipher where they could be coming from, but totally lost. Is it easy to remove that particular command from the macro. Thanks again, this has been so helpful, I ended up using 50% transparency and it really improves the look of the final presentations, Happy Holidays to you!
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39733483
Hi,

the quotation  marks come from the file

if you want to delete them

try

With oTB
.TextFrame2.WordWrap = True
.TextFrame.TextRange.Text = Replace(picDesc(1), Chr(34), "")
.Fill.ForeColor.RGB = vbWhite
.Fill.Transparency = 0.9
End With

Open in new window

Regards
0
 

Author Comment

by:cssoftware
ID: 39736781
You are right, I hadn't even noticed, thansk again and Merry Christmas
0
 

Author Closing Comment

by:cssoftware
ID: 39736785
very helpful!!
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A high-level exploration of how our ever-increasing access to information has changed the way we do our jobs.
PowerPoint is the go-to presentation software for millions of users around the world. Many presentations use basic text features but you can really make special text jump out of your slide by applying this bubble text design process. This article ha…
The viewer will learn how to edit text. This includes Font, Spacing, Resizing, Color, and other special text options.
In this Experts Exchange video Micro Tutorial, I'm going to show how small business owners who use Google Apps can save money by setting up what is called a catch-all email address in their Gmail accounts. By using the catch-all feature, small busin…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question