Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Laufzeitfehler 13

Betrifft: Laufzeitfehler 13 von: Nicole
Geschrieben am: 08.09.2004 09:16:28

Hallo zusammen!
Kann mir jemand sagen woher die Typenunverträglichkeit in Zeile 7 kommt?
Ich krieg dort immer einen Laufzeitfehler 13! Danke!



Sub Export_Textdatei()
    Dim fso As Object
    Dim txt As Object
    Dim z As Integer
    Dim s As Integer
    Dim temp As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile("D:\ESAComp Things\Textdatei.txt")
      For z = 1 To ActiveSheet.UsedRange.Rows.Count
        For s = 1 To ActiveSheet.UsedRange.Columns.Count
            temp = temp & Cells(z, s)
      Next s
      txt.WriteLine temp
      temp = ""
    Next z
  Set fso = Nothing
  Set txt = Nothing
  MsgBox "Textdatei ""D:\.txt""" & "wurde erfolgreich erstellt!"
  End Sub

  


Betrifft: AW: Laufzeitfehler 13 von: Nepumuk
Geschrieben am: 08.09.2004 09:37:03

Hallo Nicole,
ich kann den Fehler nicht nachvollziehen. Der Code lauft einwandfrei. Lade mal die Mappe auf den Server. Daten müssen keine drin sein, ich will nur den kompletten Code sehen.
Gruß
Nepumuk


  


Betrifft: AW: Laufzeitfehler 13 von: Nicole
Geschrieben am: 08.09.2004 09:45:02

Hallo Nepomuk

Hab also mal das Wichtigste raufgeladen......



Dim Mein_Export As String
Dim Meine_Datei As String
Dim Mein_Blatt As String
Dim max As Integer
Dim Antwort As String
Dim i As Integer


Sub ESAComp()

  'Dateiname_ausgeben()
  Meine_Datei = InputBox("Bitte geben sie den Dateinamen (ohne Endung) der zu verarbeitenden Excel Datei an. Sie muss bereits geöffnet sein.", "Dateieingabe")
  Meine_Datei = Meine_Datei & ".xls"
  
 
  'Tabellenblaetter_zählen()
  Windows(Meine_Datei).Activate
  max = Worksheets.Count
  
  'Makroname_ausgeben()
  Mein_Export = InputBox("Name der Exportdatei (ohne Endung) .", "Dateieingabe")
  Mein_Export = Mein_Export & ".xls"
  MsgBox Mein_Export, , "Exportiert wird in:"
 
  'Excel Datei mit dem Namen Mein_Export und einem Sheet erstellen
   Workbooks.Add
   ActiveWorkbook.SaveAs Filename:=Mein_Export
   ActiveWorkbook.Save
    
For i = 2 To max
  
  'Quell Tabellenblatt auswählen()
  Windows(Meine_Datei).Activate
  Mein_Blatt = Worksheets(i).Name
  
  Worksheets(i).Activate
  
  Range("A1").Select
  phys = ActiveCell.Value
  Select Case phys
  
  Case Is = "REINFORCED PLY"
  Call Riinforsd_pläi
  
  Case Is = "HOMOGENEOUS PLY"
  Call Homogeneous_Ply
  
  Case Is = "ADHESIVE"
  Call Adhesive
  
  Case Is = "CORE PLY, HONEYCOMB"
  Call CorePlyhoneycomb
  
  Case Is = "CORE PLY, HOMOGENEOUS"
  Call CorePlyHomogeneous
   
End Select
   
Next i

Windows(Mein_Export).Activate



Call Leerzeilen_loeschen
Call Abstandszeile_einfügen
Call Sterne_einfügen
Call Spalten_verschieben
Call Export_Textdatei
'SI Einheiten

End Sub


Sub Leerzeilen_loeschen()
    Dim j As Double
    Application.ScreenUpdating = False
     For j = (i - 1) * 140 + 120 To 2 Step -1
       If Cells(j, 1).Value = "" Then _
          Cells(j, 1).EntireRow.Delete
     Next j
    Application.ScreenUpdating = True
    
End Sub


Sub Abstandszeile_einfügen()
Dim k As Integer
   
    For k = 1 To Range("A65536").End(xlUp).Row
        If Range("A" & k).Value = "Other data = " Or Range("A" & k).Value = "name = " Then
           Rows(k + 1).Insert
           Range(Cells(k + 1, 1).Address).Select
           ActiveCell.FormulaR1C1 = "#---------------------------------------------------------------------------------"
           End If
    Next k
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "#---------------------------------------------------------------------------------"
End Sub


Sub Sterne_einfügen()
    Dim l As Integer
    Dim l2 As Integer
    For l = 1 To Range("A65536").End(xlUp).Row
        If Range("A" & l).Value = "Manufacturer = " Then
            For l2 = l To Range("A65536").End(xlUp).Row
                Range("A" & l2).Value = "#" & Range("A" & l2).Value
                If Range("A" & l2).Value = "#Other data = " Then Exit For
            Next l2
        End If
    Next l
End Sub



Sub Spalten_verschieben()
    Windows(Mein_Export).Activate
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]:R[3]C[-2]&RC[-1]:R[3]C[-1]"
    Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C1000"), Type:=xlFillDefault
    
    Range("C1:C1000").Select
    Selection.Copy
    Range("D1:D1000").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    
    Range("D1:D1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:A1000").Select
    ActiveSheet.Paste
    
    Range("B1:D1000").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
End Sub


Sub Export_Textdatei()
    Dim fso As Object
    Dim txt As Object
    Dim z As Integer
    Dim s As Integer
    Dim temp As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile("D:\ESAComp Things\Textdatei.txt")
      For z = 1 To ActiveSheet.UsedRange.Rows.Count
        For s = 1 To ActiveSheet.UsedRange.Columns.Count
            temp = temp & Cells(z, s)
      Next s
      txt.WriteLine temp
      temp = ""
    Next z
  Set fso = Nothing
  Set txt = Nothing
  MsgBox "Textdatei ""D:\.txt""" & "wurde erfolgreich erstellt!"
  End Sub


Sub Riinforsd_pläi()
  
    'Daten der Ply i einfüllen
    
    Windows(Mein_Export).Activate
    Range("A" & (i - 1) * 140 + 1).Select
    ActiveCell.FormulaR1C1 = "name = "
    Range("B" & (i - 1) * 140 + 1).Select
    ActiveCell.FormulaR1C1 = "imported ply nr. " & i - 1


    Range("A" & (i - 1) * 140 + 2).Select
    ActiveCell.FormulaR1C1 = "phys = "
    Range("B" & (i - 1) * 140 + 2).Select
    ActiveCell.FormulaR1C1 = "reinforced"
   

    Range("A" & (i - 1) * 140 + 3).Select
    ActiveCell.FormulaR1C1 = "mech = "
    
    Windows(Meine_Datei).Activate
    Range("D23").Select
    Mechart = ActiveCell.Value
    Select Case Mechart
    Case Is = 1
    Windows(Mein_Export).Activate
    Range("B" & (i - 1) * 140 + 3).Select
    ActiveCell.FormulaR1C1 = "orthotropic"
    Case Is = 2
    Windows(Mein_Export).Activate
    Range("B" & (i - 1) * 140 + 3).Select
    ActiveCell.FormulaR1C1 = "transv23"
    Case Is = 3
    Windows(Mein_Export).Activate
    Range("B" & (i - 1) * 140 + 3).Select
    ActiveCell.FormulaR1C1 = "transv12"
    Case Is = 4
    Windows(Mein_Export).Activate
    Range("B" & (i - 1) * 140 + 3).Select
    ActiveCell.FormulaR1C1 = "isotropic"
    End Select
    
    Windows(Mein_Export).Activate
    Range("A" & (i - 1) * 140 + 4).Select
    ActiveCell.FormulaR1C1 = "t = "
    Range("B" & (i - 1) * 140 + 4).Select
    ActiveCell.FormulaR1C1 = "='[" & Meine_Datei & "]" & Mein_Blatt & "'!R23C4/1000"
    etc.



  


Betrifft: AW: Laufzeitfehler 13 von: Nepumuk
Geschrieben am: 08.09.2004 11:51:45

Hallo Nicole,
da finde ich keinen Fehler. Du schreibst in Zeile 7, welche ist den von dir aus gesehen die Zeile 7? Diese?

Set fso = CreateObject("Scripting.FileSystemObject")

Dann müsste ich wissen, mit welcher Excelversion du arbeitest.
Gruß
Nepumuk


  


Betrifft: AW: Laufzeitfehler 13 von: Nepumuk
Geschrieben am: 08.09.2004 12:05:21

Hallo Nicole,
versuch es mal ohne das FileSystemObject:


Sub Export_Textdatei()
    Dim intFree As Integer
    Dim As Integer
    Dim As Integer
    Dim temp As String
    Reset
    intFree = FreeFile
    Open "D:\ESAComp Things\Textdatei.txt" For Output Access Write Lock Write As #intFree
    For z = 1 To ActiveSheet.UsedRange.Rows.Count
        For s = 1 To ActiveSheet.UsedRange.Columns.Count
            temp = temp & Cells(z, s)
        Next s
        Print #intFree, temp
        temp = ""
    Next z
    Close #intFree
    MsgBox "Textdatei ""D:\.txt""" & "wurde erfolgreich erstellt!"
End Sub


Gruß
Nepumuk


 

Beiträge aus den Excel-Beispielen zum Thema "Laufzeitfehler 13"