Zum Inhalt springen

VB + Excel + Mehrere Blätter....


Hexagon

Empfohlene Beiträge

Original geschrieben von Goos

Wenns dir allerdings die ganze Zeit nur darum ging, aus ein paar Tabellen ein paar CSV Dateien zu generieren, dann haettest wahrscheinlich viel schneller die CSV`s selbst ausm VBA raus geschrieben :D

Goos

Aber nicht bei 7 Exceldatein à 19 Tabellen und das fast jeden Tag...:P :eek: :(
Link zu diesem Kommentar
Auf anderen Seiten teilen

Original geschrieben von Goos

Nuja.....du hast dich sicher irgendwo nur vetippselt :)

Goos

Ich weiß nicht...

hier noch mal der aktuelle Code....

Private Sub cmdBTOK_Click()

    Dim iPages As Integer

    Dim iTmp As Integer

    Dim iTmp2 As Integer

    Dim iZaehler As Integer

    Dim iLength As Integer

    Dim strTmp As String

    Dim strTmp2 As String

    Dim strFileName As String

    Dim wrkBookNeu As Workbook

    Dim wrkBookOrg As Workbook

    If txtBoxUserName.TextLength < 1 Then

        MsgBox ("Kein Username eingegeben!")

        GoTo cmdBTOK_Click_Ende

    End If

    If txtBoxUserPasswort.TextLength < 1 Then

        MsgBox ("Kein Passwort eingegeben!")

        GoTo cmdBTOK_Click_Ende

    End If

    If txtBoxServer.TextLength < 1 Then

        MsgBox ("Kein Datenbankserver eingegeben!")

        GoTo cmdBTOK_Click_Ende

    End If

    Application.DisplayAlerts = False

    Set wrkBookOrg = Application.ActiveWorkbook

    iPages = ActiveWorkbook.Worksheets.Count

    For iTmp = 1 To iPages

        Set wrkBookNeu = Application.Workbooks.Add

        Do While (wrkBookNeu.Worksheets.Count > 1)

            wrkBookNeu.ActiveSheet.Delete

        Loop

        wrkBookOrg.Sheets(iTmp).Copy after:=wrkBookNeu.Sheets(1)

        wrkBookNeu.Sheets("Tabelle3").Delete

        strFileName = wrkBookNeu.ActiveSheet.Name

        iLength = Len(strFileName)

        For iZaehler = 1 To iLength

            'Überprüfung der einzelnen Zeichen

            strTmp = Mid(strFileName, iZaehler, 1)

            If strTmp < Chr$(33) Then

                strTmp = "_"

            End If

            If strTmp = "<" Or strTmp = ">" Or strTmp = "/" Or strTmp = "\" Then

                strTmp = "-"

            End If

            strTmp2 = strTmp2 + strTmp

            strTmp = ""

        Next iZaehler

        'iwrkBookNeu.SaveAs(strTmp2, xlCSV)

        wrkBookNeu.Close

        strTmp2 = ""

        strTmp = ""

    Next iTmp

    Application.DisplayAlerts = True

    End

cmdBTOK_Click_Ende:


End Sub

Bei iwrkBookNeu.SaveAs(strTmp2, xlCSV) hängt er sich immer auf...

Link zu diesem Kommentar
Auf anderen Seiten teilen

Original geschrieben von Hexagon

Aber nicht bei 7 Exceldatein à 19 Tabellen und das fast jeden Tag...:P :eek: :(

Nene ich hab doch gemeint ne kleine VBA Funktion um die Werte so als CSV zu schreiben.

Is ja kein Problem ne kleine Text Datei zu schreiben und zwischendurch ein paar Kommas einzufuegen :)

Goos

Link zu diesem Kommentar
Auf anderen Seiten teilen

...ne du drafst eigentlich nimmer nerven *g* :D

aber nimm mal das da:


Sub addtoolbar()
Const tBarName As String = "MyBar"
On Error Resume Next
CommandBars(tBarName).Delete
On Error GoTo 0
CommandBars.Add Name:=tBarName
With CommandBars(tBarName)
With .Controls.Add(ID:=1)
.Style = msoButtonCaption
.OnAction = "AddInfo"
.Caption = "Test"
End With
.Visible = True
End With
End Sub[/PHP]

Goos

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...