?
Solved

Add transparency to a Powerpoint macro command

Posted on 2013-12-18
10
Medium Priority
?
707 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 2
10 Comments
 
LVL 52

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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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 52

Accepted Solution

by:
Rgonzo1971 earned 2000 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 52

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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

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…
This video teaches viewers how to fit pictures into slides, crop and remove backgrounds, and alter photos to look more professional.
This video teaches viewers how to create handouts from their slides and helps them decide how many slides to include per handout.

752 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