VBA code to change shape in PPT not working
I need to change a shape color in a ppt file according to an excel value. I have been trying the following code, but it is not working. The logics is:
If I am analysing product A (cell), I would like to know if it was profitable (cell.offset(0,39)=1) or not (=0). If it was profitable, I needed it to paint a determined shape (that reffers to this product) green in a PPT presentation.
Could you help me out with it?
Sub UpdateShapes ()
'Setting ranges and variables
Dim cell, RangeID As Range
Set RangeID = Sheets("Teste").Range("d1:d20")
' Get a PowerPoint instance.
Dim ppapp As Object
Set ppapp = New PowerPoint.Application
' PowerPoint window visible
Dim pres As PowerPoint.Presentation
strPpPath = ThisWorkbook.Path
strPpName = strPpPath & "" & "Trial01_Rob.pptx" 'Subtituir pelo nome do seu ppt
Set pres = ppapp.Presentations.Open( _
Filename:=strPpName, Untitled:=msoFalse)
For Each cell In RangeID
If cell.Offset(0, 39).Value = 1 Then
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(231, 28, 87)
Else
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(0, 28, 87)
End If
Next
End Sub
excel vba excel-vba
add a comment |
I need to change a shape color in a ppt file according to an excel value. I have been trying the following code, but it is not working. The logics is:
If I am analysing product A (cell), I would like to know if it was profitable (cell.offset(0,39)=1) or not (=0). If it was profitable, I needed it to paint a determined shape (that reffers to this product) green in a PPT presentation.
Could you help me out with it?
Sub UpdateShapes ()
'Setting ranges and variables
Dim cell, RangeID As Range
Set RangeID = Sheets("Teste").Range("d1:d20")
' Get a PowerPoint instance.
Dim ppapp As Object
Set ppapp = New PowerPoint.Application
' PowerPoint window visible
Dim pres As PowerPoint.Presentation
strPpPath = ThisWorkbook.Path
strPpName = strPpPath & "" & "Trial01_Rob.pptx" 'Subtituir pelo nome do seu ppt
Set pres = ppapp.Presentations.Open( _
Filename:=strPpName, Untitled:=msoFalse)
For Each cell In RangeID
If cell.Offset(0, 39).Value = 1 Then
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(231, 28, 87)
Else
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(0, 28, 87)
End If
Next
End Sub
excel vba excel-vba
3
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37
add a comment |
I need to change a shape color in a ppt file according to an excel value. I have been trying the following code, but it is not working. The logics is:
If I am analysing product A (cell), I would like to know if it was profitable (cell.offset(0,39)=1) or not (=0). If it was profitable, I needed it to paint a determined shape (that reffers to this product) green in a PPT presentation.
Could you help me out with it?
Sub UpdateShapes ()
'Setting ranges and variables
Dim cell, RangeID As Range
Set RangeID = Sheets("Teste").Range("d1:d20")
' Get a PowerPoint instance.
Dim ppapp As Object
Set ppapp = New PowerPoint.Application
' PowerPoint window visible
Dim pres As PowerPoint.Presentation
strPpPath = ThisWorkbook.Path
strPpName = strPpPath & "" & "Trial01_Rob.pptx" 'Subtituir pelo nome do seu ppt
Set pres = ppapp.Presentations.Open( _
Filename:=strPpName, Untitled:=msoFalse)
For Each cell In RangeID
If cell.Offset(0, 39).Value = 1 Then
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(231, 28, 87)
Else
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(0, 28, 87)
End If
Next
End Sub
excel vba excel-vba
I need to change a shape color in a ppt file according to an excel value. I have been trying the following code, but it is not working. The logics is:
If I am analysing product A (cell), I would like to know if it was profitable (cell.offset(0,39)=1) or not (=0). If it was profitable, I needed it to paint a determined shape (that reffers to this product) green in a PPT presentation.
Could you help me out with it?
Sub UpdateShapes ()
'Setting ranges and variables
Dim cell, RangeID As Range
Set RangeID = Sheets("Teste").Range("d1:d20")
' Get a PowerPoint instance.
Dim ppapp As Object
Set ppapp = New PowerPoint.Application
' PowerPoint window visible
Dim pres As PowerPoint.Presentation
strPpPath = ThisWorkbook.Path
strPpName = strPpPath & "" & "Trial01_Rob.pptx" 'Subtituir pelo nome do seu ppt
Set pres = ppapp.Presentations.Open( _
Filename:=strPpName, Untitled:=msoFalse)
For Each cell In RangeID
If cell.Offset(0, 39).Value = 1 Then
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(231, 28, 87)
Else
pres.slides(1).Shapes(cell).Fill.ForeColor.RGB = RGB(0, 28, 87)
End If
Next
End Sub
excel vba excel-vba
excel vba excel-vba
edited Nov 16 '18 at 11:04
Pᴇʜ
23.8k62952
23.8k62952
asked Nov 15 '18 at 22:54
SophiaSophia
1
1
3
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37
add a comment |
3
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37
3
3
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ifUsing("editor", function ()
StackExchange.using("externalEditor", function ()
StackExchange.using("snippets", function ()
StackExchange.snippets.init();
);
);
, "code-snippets");
StackExchange.ready(function()
var channelOptions =
tags: "".split(" "),
id: "1"
;
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function()
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled)
StackExchange.using("snippets", function()
createEditor();
);
else
createEditor();
);
function createEditor()
StackExchange.prepareEditor(
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader:
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
,
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
);
);
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53329027%2fvba-code-to-change-shape-in-ppt-not-working%23new-answer', 'question_page');
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53329027%2fvba-code-to-change-shape-in-ppt-not-working%23new-answer', 'question_page');
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
3
What is not working? Please be more specific.
– BigBen
Nov 15 '18 at 23:37