---

Hallo,
ich habe schon eine menge versucht aber irgendwie bekomme ich es nicht gebacken. Dabei sollte das gar nicht so schwierig sein.

Ich will nur einen Wert in eine bestehende Excel Tabelle über geben!

Diese beinhaltet eine Tabelle von Werten die mit diesem "StartWert" verglichen werden und dann zurück an Inventor als Parameter dieser "Baureihe"="Startwert" gegeben werden.

Der Code unten erstellt immer nur eine neue Datei

PS.Hab ein altes Inventor (9)also geht es mit
Dim XL As New Excel.Application
nicht, wenn ich das richtig mitbekommen habe

CODE:
----------------------------------------------------------------------
Sub StartWertUebergabe()
    Dim XL As Object
    Dim xlWB As Object
    Dim xlWS As Object
   
   
    'Stellt Verbindung zu Excel her und erstellt ein neues Workbook
    'Note: OPEN_EXCEL.
    Set XL = CreateObject("Excel.Application")
    Set xlWB = XL.Workbooks.Add
    Set xlWS = xlWB.ActiveSheet
   
    XL.Application.Visible = True
   
    On Error Resume Next
   
    xlWS.Application.Cells(1, 2).Value = txtBox1.Text
    xlWS.SaveAs "C:\Temp\TEST1.XLS"
   
    On Error GoTo 0
    XL.Application.Quit
         
         
    'Passt Größe der Zeilen und Spalten an die Werte an
        'XL.Cells.Select
        'XL.Cells.EntireColumn.AutoFit
        'xlWS.Range("A1").Select
   
   
    'Löst die Verbindung von XL
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set XL = Nothing

End Sub
----------------------------------------------------------------------
Dieser Code öffnet zwar Dateien kann aber nichts dazu schreiben, jetzt bräuchte ich so zu sagen die zwischen lösung!

Code:
----------------------------------------------------------------------
Private Sub GetExcel()
    Dim XL1 As Object      ' Variable für Verweis auf
                            ' Microsoft Excel.
    Dim xlWB As Object
    Dim xlWS As Object
    Dim ExcelLiefNicht As Boolean    ' Attribut für Freigabe am Ende.
    Dim m As String, nz As String
    Dim titel As String

' Überprüfen, ob eine Kopie von Microsoft Excel bereits
' ausgeführt wird.
On Error Resume Next   
' Fehlerbehandlung zurückstellen.
' GetObject-Funktionsaufruf ohne erstes Argument gibt einen
' Verweis auf
' eine Instanz der Anwendung zurück. Wenn die Anwendung nicht
' ausgeführt wird, tritt ein Fehler auf.
    Set XL1 = GetObject(, "Excel.Application")
    Set xlWB = XL1.Workbooks.Add
    Set xlWS = xlWB.ActiveSheet
   
    If Err.Number <> 0 Then ExcelLiefNicht = True
    Err.Clear    ' Err-Objekt im Fehlerfall löschen.

' Prüfen auf Microsoft Excel. Wenn Microsoft Excel ausgeführt wird, wird
' dies in die Tabelle ausgeführter Objekte eingetragen.
'DetectExcel
    m = InputBox("Eingabe", titel, 100)
' Objektvariable so festlegen, daß sie auf die gewünschte
' Datei verweist.
    Set XL1 = GetObject("c:\vb4\TEST1.XLS")
   
    xlWS.Application.Cells(1, 1).Value = m
    xlWS.SaveAs "c:\vb4\TEST2.XLS"
   
' Microsoft Excel mit zugehöriger Application-Eigenschaft einblenden.
' Fenster mit der Datei unter Verwendung der Windows-Auflistung des
' XL1-Objektverweises anzeigen.
    XL1.Application.Visible = True
    XL1.Parent.Windows(1).Visible = True
         
    If ExcelLiefNicht = True Then
        XL1.Application.Quit
    End If

    Set XL1 = Nothing
End Sub
----------------------------------------------------------------------
Würde mich sehr freuen wenn jemand diese einfache Aufgabe für mich lösen könnte, BITTE!!!

PS:Nett wäre auch noch wenn der Wert gleich auf ein neues Sheet, wo aber auch schon werte sind, übergeben werden könnte

tjwh!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

  

Zitat:

---

Original erstellt von Joker-Work:

PS.Hab ein altes Inventor (9)also geht es mit
Dim XL As New Excel.Application
nicht, wenn ich das richtig mitbekommen habe

---

Hallo,

mal 'ne blöde Frage: wieso soll denn das nicht gehen ?

Ich vermute, dass Du einfach keinen Verweis auf Excel gesetzt hast.

Unter 'Extras' - 'Verweise' findest Du 'Microsoft Excel xx.x Object Library'. Einfach anhaken und dann geht's.

------------------
Grüsse, Paul

Inventor-Programmierung, Inventor-Tools und Inventor API-Schulung

thinkCAD Web-Kataloge

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke,
hatte natürlich den Verweis nicht gesetzt, geht aber auch ohne (Siehe Code), hab es dann doch hin bekommen.

CODE:
----------------------------------------------------------------------
Sub DatenUebergabe()

'    Dim XL As New Excel.Application
'    Dim xlWB As Excel.Workbook
'    Dim xlWS As Excel.WorkSheet
    Dim XL As Object
    Dim xlWB As Object
    Dim xlWS As Object
   
   
    'Stellt Verbindung zu Excel her und erstellt ein neues Workbook
    'Note: OPEN_EXCEL.
    On Error Resume Next
    'Set XL = CreateObject("Excel.Application")
    'Set XL = GetObject(, "Excel.Application")
    Set xlWB = XL.Workbooks.Add
    Set xlWS = xlWB.ActiveSheet
   
   
    Set XL = GetObject("c:\vb4\TEST1.XLS")
    XL.Application.Visible = True
    XL.Parent.Windows(1).Visible = True
     
    XL.Application.Cells(1, 2).Value = txtBox1.Text
    'xlWS.SaveAs "C:\Temp\TEST1.XLS"
    On Error GoTo 0
   
   
      '  XL.Application.Quit
         
    'Passt Größe der Zeilen und Spalten an die Werte an
        'XL.Cells.Select
        'XL.Cells.EntireColumn.AutoFit
        'xlWS.Range("A1").Select
   
   
    'Löst die Verbindung von XL
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set XL = Nothing
 

End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP