Anzeige
Archiv - Navigation
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro verbessern

Makro verbessern
Sascha
Hallo Forum
Bei dem Makro unten habt ihr mir schon mal geholfen es fügt aus einer TXT Datei daten in Excel ein.
Das einfügen Funktioniert auch Super nur dann kommt immer eine MessageBox
ABBRUCH
Bitte Daten eingeben !
Kann man das ändern das die Meldung nur kommt wenn ein fehler entsteht oder ganz rausnehmen.
Danke schon mal und Grüsse
Sascha
Option Explicit
Sub import202TXTauto()
Dim strFile As String
Dim lngRow As Long
On Error GoTo ErrExit
strFile = Sheets("Berechnungsgrundlagen").Range("E11")
If strFile = CStr(False) Then GoTo ErrExit
With Application
.EnableEvents = False
.DisplayAlerts = False
End With
With Sheets("Import 202")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
With .QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=.Cells(lngRow, 1))
.Name = Left(strFile, Len(strFile) - 3)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 5, 9)
.TextFileFixedColumnWidths = Array(3, 9, 4, 4, 4, 9, 6, 1, 6, 38, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
.Columns("A:E").AutoFit
End With
ErrExit:
With Err
If .Number  0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (import202TXTauto) in Modul", _
vbExclamation, "Fehler in Modul / import202TXTauto"
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro verbessern
12.06.2010 09:36:24
Matthias
Hallo
ungetestet ...
Option Explicit
Sub import202TXTauto()
Dim strFile As String
Dim lngRow As Long
On Error GoTo ErrExit
strFile = Sheets("Berechnungsgrundlagen").Range("E11")
If strFile = CStr(False) Then GoTo ErrExit
With Application
.EnableEvents = False
.DisplayAlerts = False
End With
With Sheets("Import 202")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
With .QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=.Cells(lngRow, 1))
.Name = Left(strFile, Len(strFile) - 3)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 5, 9)
.TextFileFixedColumnWidths = Array(3, 9, 4, 4, 4, 9, 6, 1, 6, 38, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
.Columns("A:E").AutoFit
End With

With Application
.EnableEvents = True
.DisplayAlerts = True
End With
Exit Sub

ErrExit:
With Err
If .Number  0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (import202TXTauto) in Modul", _
vbExclamation, "Fehler in Modul / import202TXTauto"
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Gruß Matthias
Anzeige
AW: Makro verbessern
12.06.2010 23:03:49
Sascha
Danke Matthias
Das hat Funktioniert hab aber fest gestellt das ich zwei Makros verknüpft habe und im zweiten Makro ist der Fehler drin der die Meldung bringt.
Hoffe das es da auch eine Lösung gibt.
Gruss Sascha
Sub feierabendzeit()
Dim i As Long, z As Long, lngLastRow As Long
Dim myDate
With Sheets(1)
lngLastRow = .Cells.Find(What:="*", after:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 4 To lngLastRow
If WorksheetFunction.CountA(.Range(.Cells(i, 1), .Cells(i, 13))) > 0 Then
If .Cells(i, 6) = "" Then
MsgBox "Bitte Daten eingeben !", vbCritical, "ABBRUCH"
Exit For
End If
If .Cells(i, 11) = "" Then
myDate = InputBox("Bitte Feierabendzeit vom: " & .Cells(i, 11).Offset(, -5) & "  _
eingeben!        z.B.: 19:30", "Heute ist der " & Date)
If IsDate(myDate) Then
z = i
Do
.Cells(z, 11) = myDate
z = z + 1
Loop Until .Cells(z, 6)  .Cells(i, 6)
Else
MsgBox "Bitte gültige Uhrzeit eingeben ! z.B.: 19:30", vbCritical, "Fehler"
Exit For
End If
End If
End If
Next
End With
End Sub

Anzeige
AW: nicht 2x offen
13.06.2010 20:15:31
Hajo_Zi

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige