Edit Excel Cell with ActiveX

30 Views Asked by At

Im trying to edit a Cell in my Excel Sheet with an ActiveX Macro (from Powerpoint). But the value never appears in that cell. I even see in the file explorer that the File have been edited.

Private Sub ScrollBar1_Change()

    Dim xlApp As Object
    Dim xlSheet As Object
    Dim scrollbarValue As Integer
    
    ' Verweis auf Excel herstellen
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    
    ' Fehlerbehandlung für den Dateizugriff
    On Error GoTo ErrorHandler
    
    ' Arbeitsmappe öffnen
    xlApp.Workbooks.Open "{absolute path}\Diagramm.xlsx"
    ' Blatt auswählen (hier das erste Blatt)
    Set xlSheet = xlApp.Worksheets(1)
    
    ' Wert der Scrollleiste abrufen
    scrollbarValue = ScrollBar1.Value

    ' Wert in Excel-Zelle eintragen
    xlSheet.Cells(1, "A").Value = scrollbarValue

    ' Excel schließen
    xlApp.Quit

    ' Speicher freigeben
    Set xlSheet = Nothing
    Set xlApp = Nothing
    
    Exit Sub

ErrorHandler:
    MsgBox "Fehler beim Zugriff auf die Excel-Datei: " & Err.Description
    ' Freigabe von Ressourcen
    If Not xlSheet Is Nothing Then Set xlSheet = Nothing
    If Not xlApp Is Nothing Then
        xlApp.Quit
        Set xlApp = Nothing
    End If
    
End Sub

I've tried writing hard-coded Values , with xlSheet.Range("A1").Value = and other formats .Cells(1, 1) but nothing appears

1

There are 1 best solutions below

0
VBasic2008 On

Write to Excel From PowerPoint

  • To keep things simple, I didn't consider the cases when the file is already open or when a different file with the same name is open.
Private Sub ScrollBar1_Change()

    ' Define constants.
    Const FILE_PATH As String = "{absolute path}\Diagramm.xlsx"
    Const WORKSHEET_ID As Variant = 1
    Const CELL_ADDRESS As String = "A1"

    ' Check if file doesn't exist.
    Dim Filename As String: Filename = Dir(FILE_PATH)
    If Len(Filename) = 0 Then
        MsgBox "The file """ & FILE_PATH & """ doesn't exist!", vbExclamation
        Exit Sub
    End If

    Dim xlApp As Object, WasExcelRunning As Boolean
    
    ' Verweis auf Excel herstellen
    On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    Else
        WasExcelRunning = True
    End If
    
    Dim xlBook As Object, xlSheet As Object, WasSuccessful As Boolean
    
    ' Fehlerbehandlung für den Dateizugriff
    On Error GoTo ErrorHandler
    
    ' Arbeitsmappe öffnen
    Set xlBook = xlApp.Workbooks.Open(FILE_PATH)
    ' Blatt auswählen (hier das erste Blatt)
    Set xlSheet = xlBook.Worksheets(WORKSHEET_ID)

    ' Wert in Excel-Zelle eintragen
    xlSheet.Range(CELL_ADDRESS).Value = ScrollBar1.Value
    
    WasSuccessful = True
    
ProcExit:
    On Error Resume Next
        ' Save and close the workbook.
        If Not xlBook Is Nothing Then xlBook.Close WasSuccessful
        ' Excel schließen, if it was not open
        If Not WasExcelRunning Then xlApp.Quit
        ' Inform.
        If WasSuccessful Then MsgBox "Value copied.", vbInformation
    On Error GoTo 0
    Exit Sub
ErrorHandler:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit
End Sub