---

Servus,
mal wieder ich 
ich möchte Daten von ACAD nach Excel exportieren. Das klappt auf den ersten Blick auch wunderbar. Nun stellt sich aber die Frage, wenn ich weitere Daten hinzufügen möchte, wie erkennt das System, welches Workbook er gefuellt hat. Der User kann nämlich weitere Excelworkbooks auf haben.

Kann man ein gerade erzeugtes Workbook direkt benennen, so wie bei Sheets?

ein Wochenendgruß
Tom

Code:

---

Sub Excelexport(ObjTyp As String, texthoehe As Double, Flaeche1 As Double, Umfang1 As Double, dicke As Double, WandHoehe As Double, material As String, volumen As Double, bem As String, iz As Integer, laenge As Double, breite As Double)
    'Exportiert nach Excel
  Dim appExcel As Excel.Application
  Dim wbk As Excel.Workbook
  Dim wks As Excel.Worksheet
'  On Error GoTo Excelexport_Error
   
 
'Excel übergabe
 
  Set appExcel = CreateObject("Excel.Application")
  appExcel.Visible = True
  Set wbk = appExcel.Workbooks.Add
   
 
  'wbk.Name = "calculate"
  'Set wks = wbk.Sheets(1) '1. Arbeitsblatt
  wbk.Worksheets.Add
 
 
  wbk.ActiveSheet.Name = ObjTyp
  Set wks = wbk.Worksheets(ObjTyp)
 
  'Kopfzeile
 
    wks.Cells(1, 1) = "Nr"
    wks.Cells(1, 2) = "Typ"
    wks.Cells(1, 3) = "Material"
    'Werte ab Zeile 2
    wks.Cells(2, 1) = 1
    wks.Cells(2, 2) = ObjTyp
    wks.Cells(2, 3) = material
   
    Select Case ObjTyp
        Case "Wand"
            wks.Cells(1, 4) = "Dicke"
            wks.Cells(1, 5) = "Länge"
            wks.Cells(1, 6) = "Höhe"
            wks.Cells(1, 7) = "1-S. Fläche"
            wks.Cells(1, 8) = "2-S. Fläche"
            wks.Cells(1, 9) = "Volumen"
            wks.Cells(1, 10) = "Bemerkung"
            wks.Cells.Range("A1:I1").Font.Bold = True  ' Fettschrift
           
            'Werte
            wks.Cells(2, 4) = dicke
            wks.Cells(2, 5) = laenge
            wks.Cells(2, 6) = WandHoehe
            wks.Cells(2, 7) = Flaeche1
            wks.Cells(2, 8) = (Flaeche1 * 2)
            wks.Cells(2, 9) = volumen
            wks.Cells(2, 10) = bem
           
        Case "Decke"
            wks.Cells(1, 4) = "Dicke"
            wks.Cells(1, 5) = "Fläche"
            wks.Cells(1, 6) = "Volumen"
            wks.Cells(1, 7) = "Umfang"
            wks.Cells(1, 8) = "Umfangsfläche"
            wks.Cells(1, 9) = "Bemerkung"
            wks.Cells.Range("A1:I1").Font.Bold = True  ' Fettschrift
           
            'Werte
            wks.Cells(2, 4) = dicke
            wks.Cells(2, 5) = Flaeche1
            wks.Cells(2, 6) = volumen
            wks.Cells(2, 7) = Umfang1
            wks.Cells(2, 8) = Uffl
            wks.Cells(2, 9) = bem
           
       
           
    End Select

  On Error GoTo 0
  Exit Sub

Excelexport_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Excelexport of Modul Allgemein"
End Sub

---

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

---

Hallo tomww,

lass doch das Excelworkbook durch das Makro abspeichern z.B. in das Temp-Verzeichniss oder so.

Dadurch bekommt das Workbook nen Namen und du kannst es direkt mit dem Namen ansprechen und aktiv machen bevor der weitere Export beginnt.

Ich so ähnlich sieht der Aufruf dann aus:
Excel.Workbooks("Export").Activate

Ich hoffe das hat geholfen, lass michs wissen!

Viel Glück!

------------------
Mfg Andreas

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

---

Hallo Andreas,

danke fuer deinen Tipp. Habe es folgendermaßen nun umgesetzt. Dabei kommt ein Index Fehler in der Ativate Zeile. Ein weiteres Excelfenster ohne Sheet wird geöffnet. Ich habe wohl da immer noch ein Gedankenfehler drin? 

Code:

---

'Excel übergabe
 
  Set appExcel = CreateObject("Excel.Application")
  appExcel.Visible = True 

  If IsEmpty(fName) = True Then   
    Set wbk = appExcel.Workbooks.Add
    'Abspeichern Datei
 
    Do
        fName = appExcel.GetSaveAsFilename
    Loop Until fName <> False
 
  wbk.SaveAs FileName:=fName

  Else

    appExcel.Workbooks(fName).Activate  'aktiviert d. offenen Workbook

  End If
 

  wbk.Worksheets.Add
 
 
  wbk.ActiveSheet.Name = ObjTyp
  Set wks = wbk.Worksheets(ObjTyp)

---

im Gesamtcode

Code:

---

Sub Excelexport(ObjTyp As String, texthoehe As Double, Flaeche1 As Double, Umfang1 As Double, dicke As Double, WandHoehe As Double, material As String, volumen As Double, bem As String, iz As Integer, laenge As Double, breite As Double)
    'Exportiert nach Excel
  Dim appExcel As Excel.Application
  Dim wbk As Excel.Workbook
  Dim wks As Excel.Worksheet
'  On Error GoTo Excelexport_Error
   
 

'Excel übergabe
 
  Set appExcel = CreateObject("Excel.Application")
  appExcel.Visible = True 

  If IsEmpty(fName) = True Then   
    Set wbk = appExcel.Workbooks.Add
    'Abspeichern Datei
 
    Do
        fName = appExcel.GetSaveAsFilename
    Loop Until fName <> False
 
  wbk.SaveAs FileName:=fName

  Else

    appExcel.Workbooks(fName).Activate  'aktiviert d. offenen Workbook

  End If
 

  wbk.Worksheets.Add
 
 
  wbk.ActiveSheet.Name = ObjTyp
  Set wks = wbk.Worksheets(ObjTyp)
 
  'Kopfzeile
 
    wks.Cells(1, 1) = "Nr"
    wks.Cells(1, 2) = "Typ"
    wks.Cells(1, 3) = "Material"
    'Werte ab Zeile 2
    wks.Cells(2, 1) = 1
    wks.Cells(2, 2) = ObjTyp
    wks.Cells(2, 3) = material
   
    Select Case ObjTyp
        Case "Wand"
            wks.Cells(1, 4) = "Dicke"
            wks.Cells(1, 5) = "Länge"
            wks.Cells(1, 6) = "Höhe"
            wks.Cells(1, 7) = "1-S. Fläche"
            wks.Cells(1, 8) = "2-S. Fläche"
            wks.Cells(1, 9) = "Volumen"
            wks.Cells(1, 10) = "Bemerkung"
            wks.Cells.Range("A1:I1").Font.Bold = True  ' Fettschrift
           
            'Werte
            wks.Cells(2, 4) = dicke
            wks.Cells(2, 5) = laenge
            wks.Cells(2, 6) = WandHoehe
            wks.Cells(2, 7) = Flaeche1
            wks.Cells(2, 8) = (Flaeche1 * 2)
            wks.Cells(2, 9) = volumen
            wks.Cells(2, 10) = bem
           
        Case "Decke"
            wks.Cells(1, 4) = "Dicke"
            wks.Cells(1, 5) = "Fläche"
            wks.Cells(1, 6) = "Volumen"
            wks.Cells(1, 7) = "Umfang"
            wks.Cells(1, 8) = "Umfangsfläche"
            wks.Cells(1, 9) = "Bemerkung"
            wks.Cells.Range("A1:I1").Font.Bold = True  ' Fettschrift
           
            'Werte
            wks.Cells(2, 4) = dicke
            wks.Cells(2, 5) = Flaeche1
            wks.Cells(2, 6) = volumen
            wks.Cells(2, 7) = Umfang1
            wks.Cells(2, 8) = Uffl
            wks.Cells(2, 9) = bem
           
       
           
    End Select

  On Error GoTo 0
  Exit Sub

Excelexport_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Excelexport of Modul Allgemein"
End Sub

---

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

---

Du benötigst eigentlich gar keinen Activate-Käse & Consorten,
da du das workbook als auch das Sheet Objekt (Collection) über den Index/Namen direkt ansprechen kannst.
Bei Workbooks.Add ist dann das neue WB eh das Active-WB;-)
Ich würde eher bei Workbooks.Add erst mal den Namen abfragen oder das neue Kind exakt benimen.
Irgendwie komm ich da noch nicht ganz klar, was das werden soll.

Weiters, ein SaveAs ist recht blöde manchmal, einfach deswegen, da ein SaveAs die MutterDatei schliesst und Feierabend;-)

Was spricht hier erstmal gegen ein normales 'save' mit einem verbindlichen Namen?

So wie ich den Code lese, erzeugst du irgendwelche Mappen, die automatisch 'Mappe1', Mappe2 ... usw.
heissen und speicherst diese kurzum via saveas ab und sie werden geschlossen.
Klar dass dann der Index Zuordungsschwierigkeiten bekommt;-)

Mal nur so paar Gedanken in der Werbepause;-)

Grüße, Nancy

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

---

Huuhu,
nun ist die Sendung zu Ende? :-)
warum weshalb ...

ich weiss nicht wie der User die Datei nennen muss und wo er es abspeichern wird. Die arbeiten dummerweise in verschiedenen Abteilungen.

Mit dem saveAs Konstrukt kann ich diesen Save-Dialog von Windows nutzen (habe dies aus der Hilfe)

Der Hintergedanke von diesem alle ist, dass nach dem Abspeichern der ersten Daten, zB Wand in dem Sheet Wand, noch im selben Workbook die Daten fuer Decke und wenn ich noch nerven habe fuer andere Konstruktionen bestehen soll.

Mhh, wie wuerde ein Geniale Moderatorin dies angehen?

Tom
PS:
Kommendes nächste Problem
By the way schwant mir schon das nächste Desaster: unterschiedliche Excel Verweise :-((((((

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

---

Hi Tom,

okay, ist glaube jetzt klar,
beim saveas war ich excelintern in Gedanken,
aber wir sind ja 'von aussen' ;-)

Bin etwas eingerostet, aber mal als Ansatz,
schau mal ob das in etwa hinkommt:

Code:

---

Sub tom()
    Dim xlApp As Object
    Dim xlWB As Object
    Set xlApp = CreateObject("Excel.application")
    Set xlWB = xlApp.workbooks.Add
    With xlWB.sheets("Tabelle1")
        .cells(1, 1) = "A"
        .cells(1, 2) = "B"
        .cells(1, 3) = "C"
    End With
    xlApp.Visible = 1

'Theoretisch könnteste hier beenden und der User speichert selber weiter ab
'Exit Sub

'oder aber weiter
    Dim bla As Variant, xxx As Variant
    bla = xlApp.getsaveasfilename("xls, *.xls")
    While bla = 0
        MsgBox "dat war nix ..."
        bla = xlApp.getsaveasfilename("xls, *.xls")
    Wend
    xlWB.SaveAs bla
    xlApp.workbooks.Open bla
    xxx = Split(bla, "\")
    Set xlWB = xlApp.workbooks(xxx(UBound(xxx)))
End Sub

---

Grüsse, Nancy

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

---

Uii, bist ja auch eine Nachteule, so spät noch gearbeitet.
ich habe den unteren Teil von dir eingebaut. Es wird aber nun eine Kopie vom ersten Workbook erzeugt. Sprich, gleicher Name, aber schreibgeschützt und es enthält nicht den Sheet/Daten von der ersten Erstellung.

Und zwar werden die Routinen von einem Formular aus aufgerufen. Ist das Formular noch offen kann/soll der User weitere Daten in diesen offenen Workbook schreiben. Die meisten User haben aber meist noch andere Excelworkbooks auf (da holen die irgendwelche benötigten Infos heraus).
Daher mein Gedankenchaos wie ich in dem aus ACAD erzeugten Workbook weitere Daten/Sheets einpflegen kann.

Ohh mein Hirn    

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

---

Hallo!

appExcel.Workbooks(fName).Activate 

fName dürfte hier kein Pfad sein, sondern nur der Workbookname und hinter dem muss ".xls" stehen, sonst kommt der Indexfehler

AppActivate (appExcel)
appExcel.workbooks("test.xls").Activate

Probiers mal so, das appactivate muss auch rein, damit wird zuerst Excel aktiv, und dann das Workbook (der Indexfehler tritt auf wenn der Name falsch ist)

------------------
Mfg Andreas

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

---

Hi Tom, hier bin ich nochmal!

Hab hier nen kleinen Testaufbau gestaltet.

Code:

---

Sub Testaufbau()

Set appExcel = CreateObject("Excel.Application")
  appExcel.Visible = True                              'Excel starten
 
    appExcel.workbooks.add                              'Neues Workbook
    appExcel.workbooks.Open ("C:\test.xls")            'Workbook test.xls öffnen
    appExcel.workbooks.Open ("C:\test2.xls")            'Workbook test2.xls öffnen
 
AppActivate "AutoCAD 2006"                              'zurück zu Autocad wechseln

MsgBox "Excel ist gestartet und das letzte aktive Workbook war test2.xls. AutoCAD ist aktiv"
MsgBox "Jetzt wir zu Excel gewechselt und das Workbook test.xls aktiv gemacht"

AppActivate (appExcel)                                'Excel Aktivieren
  appExcel.workbooks("test.xls").Activate            'Workbook test.xls aktivieren

End Sub

---

------------------
Mfg Andreas

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

---

Super, nun habe ich Nancy's und Andreas Vorschläge kombiniert und es läuft! Klasse Hilfe!!!!
danke schööööön
Tom

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

---

Zitat:

---

Original erstellt von Andreas Widmann:

Code:

---

Sub Testaufbau()

Set appExcel = CreateObject("Excel.Application")
  appExcel.Visible = True                              'Excel starten
 
    appExcel.workbooks.add                              'Neues Workbook
    appExcel.workbooks.Open ("C:\test.xls")            'Workbook test.xls öffnen
    appExcel.workbooks.Open ("C:\test2.xls")            'Workbook test2.xls öffnen
 
AppActivate "AutoCAD 2006"                              'zurück zu Autocad wechseln

MsgBox "Excel ist gestartet und das letzte aktive Workbook war test2.xls. AutoCAD ist aktiv"
MsgBox "Jetzt wir zu Excel gewechselt und das Workbook test.xls aktiv gemacht"

AppActivate (appExcel)                                'Excel Aktivieren
  appExcel.workbooks("test.xls").Activate            'Workbook test.xls aktivieren

End Sub

---

---

Jetzt hatte ich es fast hinbekommen, nach dem  vom "microcontroller- u. VB Forum, zum VBA- u. Cad Forum und visa versa...:(  zu diesem schönen Testaufbau() kam!
Aber meins will noch immer nicht!
Ich will einfach aus meinem VB.NET Form per button Werte in ein geöffnetes Excelsheet schreiben. Würde bzw. geht auch soweit, aber ich krieg es nicht hin, dass es immer ins selbe Sheet/Workbook schreibt. Es öffnet sich bei mir immer ein neues, schreibgeschütztes Excelprogramm mit gleichem Namen.

Code:

---

        Dim oExcel As Object
        Dim oBook As Object
        Dim oSheet As Object

        'Excel starten
        oExcel = CreateObject("Excel.Application")
        oExcel.Visible = True

        If oExcel.Caption = "test20070926" Then
            oBook = oExcel.workbooks("test20070926.xls").Activate()
        Else
            oBook = oExcel.workbooks.Open("C:\test\test20070926.xls")
        End If

        'Add data to cells of the first worksheet in the new workbook.
        oSheet = oBook.Worksheets(1)
        oSheet.Range("A1").Value = "A-wert"
        oSheet.Range("B1").Value = "B-wert"
        oSheet.Range("A1:B1").Font.Bold = True
        oSheet.Range("A2").Value = NewA
        oSheet.Range("B2").Value = NewB

---

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

---

Hallo allerseits also ich machs immer folgendermaßen
Mit createobject erzeugst du immer eine Neue Excel Instanz!!
nur mit getobject kannst du in ein offenes reinschreiben!

Public Excel

Sub test
Call InitExcel("Pos-Planliste", 0) 'bei 0 macht er nix bei 1 löscht er den Inhalt des Blattes
'er sucht in Excel nach dem Blatt Pos-PLanliste
'wenn es dieses nicht gibt wird es neu erzeugt!

end sub

Sub InitExcel(Blattname, löschen)
Dim xlse, Mat'oder hier "Excel" definieren
   
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
  If Err <> 0 Then
        Set Excel = CreateObject("Excel.Application")
        Excel.Visible = True
        Excel.Workbooks.Add
        'Exit Sub
  End If
Excel.ActiveWorkbook

For Each xlse In Excel.ActiveWorkbook.Sheets
'MsgBox xlse.Name
If xlse.Name = Blattname Then Mat = 1
Next xlse
If Mat <> 1 Then
Excel.Sheets.Add.Name = Blattname
End If
Excel.Sheets(Blattname).Select
If löschen = 1 Then
  Excel.ActiveSheet.Cells.Delete
End If
Excel.ActiveSheet.Range("A1").Select
End Sub

[Diese Nachricht wurde von c.schojer am 26. Sep. 2007 editiert.]

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

---

Hallo,
danke, aber ich blick da noch nicht durch, mit Excel = GetObject(, "Excel.Application") gibt es bei mir eine Fehlermeldung...

Das Bsp. von Nancy ist doch eigentlich super einfach, so brauch ich das! NUR eben dass in das geöffnete Excel geschrieben wird und nicht in ein neu erzeugtes.
Ich krieg das nicht hin mit GetObject anstatt mit dem CreateObject 

Code:

---

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim xlApp As Object
        Dim xlWB As Object
        xlApp = CreateObject("Excel.application")
        xlWB = xlApp.workbooks.Add
        xlWB.sheets("Tabelle1").cells(1, 1) = "A"
        xlApp.Visible = 1
    End Sub

---

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

---

Groß Kleinschreibung beachten!!
beide programme funktionieren bei mir von Autocad aus!
Set sollte man nicht vergessen!!!

  Sub testcreate_excel()
        Dim xlApp  As Object
        Dim xlWB As Object
        Set xlApp = CreateObject("Excel.Application")
        Set xlWB = xlApp.Workbooks.Add
        xlWB.Sheets("Tabelle1").Cells(1, 1) = "A"
        xlApp.Visible = 1
    End Sub

  Sub testget_excel()
        'Hierfür muß Excel offen sein
        'Sonst Fehler!!
       
        Dim xlApp  As Object
        Dim xlWB As Object
        Set xlApp = GetObject(, "Excel.Application")
        'Set xlWB = xlApp.Workbooks.Add 'ich will ja kein neues hinzufügen
        xlApp.Sheets("Tabelle1").Cells(1, 1) = "A"
        xlApp.Visible = 1
    End Sub

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

---

Hallo,
versuchs mal so. Leg dir eine Form an mit einem Listenfeld und häng den Code z.B. an einen Button.

Code:

---

    ' Liste der Exceldateien leeren
    Me.Lst_Exceldateien.Clear
   
    ' Excel Objekt zurücksetzen
    Set og_ExcelApp = Nothing
    ' Fehlerbehandlung
    On Error Resume Next
    ' Versuch ein Excelobjekt zu finden
    Set og_ExcelApp = GetObject(, "Excel.Application")
    ' Fehlerbehandlung
    If Err.Number <> 0 Then
        On Error GoTo 0
        '' Excel läuft noch nicht
        Set og_ExcelApp = CreateObject("Excel.Application")
        og_ExcelApp.Visible = True
        og_ExcelApp.Workbooks.Add
    End If
    On Error GoTo 0
    ' Liste der offenen Dokumente füllen
    For Each og_ExcelWorkbook In og_ExcelApp.Workbooks
        Me.Lst_Exceldateien.AddItem og_ExcelWorkbook.Name & "-->" & og_ExcelWorkbook.FullName
    Next

---

Wenn eine Datei auf ist wird sie gelistet, ansonsten wird Excel gestartet.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo,
und vielen Dank! Ich benutze VB.NET, (Visual Studio Express Editions 2005)

Das Bsp. von c.schojer ist in der Art, wie ich es gerne hätte, nur lief es bei mir gar nicht gestern.
Heute funktioniert es aber! 
Als Test lasse ich aus VB heraus eine Uhr in Excel Zelle A1 laufen, funktioniert soweit gut.

Das Problem ist nun, dass Excel immer den Focus hat u. ich in keinem anderen Programm arbeiten kann... Da bin ich nun grad am suchen, wie man den Focus wegnehmen kann, aber Excel noch sichtbar hat, halt der Normalzustand von einem geöffneten Programm.

Code:

---

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim xlApp As Object
        xlApp = GetObject(, "Excel.Application")
        xlApp.Sheets("Tabelle1").Cells(1, 1) = My.Computer.Clock.LocalTime.ToLongTimeString
        xlApp.Visible = 1
    End Sub

---

Stelli1, dein Bsp. ist mir schon zu kompliziert, soviel brauche ich doch gar nicht?
Danke

PS. Wenn ich das mit dem Focus herausgefunden habe, schreib ich es hier rein.

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

---

Hallo,

Zitat:

---

Original erstellt von dupl:
..Stelli1, dein Bsp. ist mir schon zu kompliziert, soviel brauche ich doch gar nicht?
..

---

Eigentlich brauchst du es schon. Ansonsten läuft dein Programm nicht wenn kein Excel gestartet ist. Und mit dem Beispielcode wird es ein wenig flexibler.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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