Macro To Edit Excel Sheet

[Bryan Vest]

I need a macro so when the user hits a button in excel it subracts 50 from an external spreadsheet. For example there is a go button on the powerpoint. Once the user clicks it I want it to subtract 50 from the cell A3 in a spreadsheet located at C:\temp.xlsx.

I cant seem to find a way anywhere on how to do this. Any ideas?

[John Wilson]

So is the button in Excel or PowerPoint

I guess PPt because that's harder!

Sub subtract50()
Dim oXlApp As Object
Dim oXlBk As Object
Dim b_open As Boolean
Dim i As Integer
On Error Resume Next
Err.Clear
Set oXlApp = GetObject(Class:="Excel.Application")
If Err <> 0 Then
Set oXlApp = CreateObject("Excel.Application")
Else
For Each oXlBk In oXlApp.Workbooks
If oXlBk.FullName = "C:\Temp.xlsx" Then
b_open = True
Exit For
End If
Next oXlBk
End If
If b_open = False Then Set oXlBk = oXlApp.Workbooks.Open("C:\Temp.xlsx")
oXlBk.Sheets(1).Range("A3") = oXlBk.Sheets(1).Range("A3") - 50
If b_open = False Then
oXlBk.Save
oXlBk.Close
oXlApp.Quit
End If
End Sub

[Bryan Vest]

That worked perfectly! Thank you so much. I am now though trying to assign it to a keyboard shortcut and cant seem to find this in powerpoint. Any ideas now to make it so when they hit Ctrl+W it activates the macro?

[John Wilson]

PowerPoint doesn't have that facility.

[Bryan Vest]

I got it going. Thanks! Another thing if you have a chance is that I need to add checkboxes to this noW. I am not sure hoW this Would be done? I need a checkbox to if checked add the 50 and if not then subtract 50. Is this possible in poWerpoint?

[John Wilson]

I've uploaded a demo showing how you might go about this:

http://www.pptalchemy.co.uk/Downloads/Demo.ppt

[Bryan Vest]

I've uploaded a demo showing how you might go about this:



Sweet thanks! I was able to get all 5 checkboxes working and everything seems good. The only thing is that I am trying to make it so if the value in the cell B3 was less than the amount already in there then have it goto slide 3.

Here is my code I am trying

Private Sub CommandButton1_Click()
Dim oXlApp As Object
Dim oXlBk As Object
Dim b_open As Boolean
Dim i As Integer
On Error Resume Next
Err.Clear
Set oXlApp = GetObject(Class:="Excel.Application")
If Err <> 0 Then
Set oXlApp = CreateObject("Excel.Application")
Else
For Each oXlBk In oXlApp.Workbooks
If oXlBk.FullName = "U:\Incentive\data\Incentive Data Source.xlsx" Then
b_open = True
Exit For
End If
Next oXlBk
End If
If b_open = False Then Set oXlBk = oXlApp.Workbooks.Open("U:\Incentive\data\Incentive Data Source.xlsx")
Set numcur = oXlBk.Sheets(1).Range("B3")
If Me.CheckBox1 Then
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") + 50
Else
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") - 50
End If
If Me.CheckBox2 Then
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") + 50
End If
If Me.CheckBox3 Then
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") + 50
End If
If Me.CheckBox4 Then
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") + 50
End If
If Me.CheckBox5 Then
oXlBk.Sheets(1).Range("B3") = oXlBk.Sheets(1).Range("B3") + 50
End If
ActivePresentation.UpdateLinks
If b_open = False Then
oXlBk.Save
oXlBk.Close
oXlApp.Quit
End If
If numcur < oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(2).SlideIndex)
End With
End If
If numcur > oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(3).SlideIndex)
End With
End If

End Sub



I use this to set it as soon as the vba opens the worksheet

Set numcur = oXlBk.Sheets(1).Range("B3")

and then try to have the slide move based on this
If numcur < oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(2).SlideIndex)
End With
End If
If numcur > oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(3).SlideIndex)
End With
End If



The problem is it always seems to goto slide 3 no matter the outcome. Any ideas?

[John Wilson]

First you can simplify the code. You only need to say
If numcur < oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (2)
End With
End If
If numcur > oXlBk.Sheets(1).Range("B3") Then
With SlideShowWindows(1)
.View.GotoSlide (3)
End With
End If
More important though!!! Since you have closed oXlApp and oXlBk they don't exist so the value will default to zero. numcur will be > 0 so .....

Just close later in the code.