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!

[VBA]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[/VBA]

[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

[vba]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
[/vba]


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

[vba]Set numcur = oXlBk.Sheets(1).Range("B3")[/vba]

and then try to have the slide move based on this
[vba] 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
[/vba]


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
[vba]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 [/vba]
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.