Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Inhalt dieser Seite

Import zur Anzeige in MsgBoxes

Sub WriteInMsgBoxes()
   Dim cln As New Collection
   Dim arrAct As Variant
   Dim intNo As Integer, intCounter As Integer
   Dim txt As String, strMsg As String
   Dim bln As Boolean
   intNo = FreeFile
   Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intNo
   Do Until EOF(intNo)
      If bln = False Then
         Line Input #intNo, txt
         arrAct = SplitString(txt, ",")
         For intCounter = 1 To UBound(arrAct)
            cln.Add arrAct(intCounter)
         Next intCounter
      Else
         Line Input #intNo, txt
         arrAct = SplitString(txt, ",")
         For intCounter = 1 To UBound(arrAct)
            strMsg = strMsg & cln(intCounter) & ": " & _
               arrAct(intCounter) & vbLf
         Next intCounter
      End If
      If bln Then MsgBox strMsg
      bln = True
      strMsg = ""
   Loop
   Close intNo
End Sub

Import zur Konvertierung in eine HTML-Seite

Sub WriteInHTML()
   Dim arrAct As Variant
   Dim intSource As Integer, intTarget As Integer, intCounter As Integer
   Dim txt As String, strTag As String
   Dim bln As Boolean
   intTarget = FreeFile
   Open ThisWorkbook.Path & "\TextImport.htm" For Output As #intTarget
   Print #intTarget, "<html><body><table>"
   intSource = FreeFile
   Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
   Do Until EOF(intSource)
      If bln Then strTag = "td" Else strTag = "th"
      Line Input #intSource, txt
      arrAct = SplitString(txt, ",")
      Print #intTarget, "<tr>"
      For intCounter = 1 To UBound(arrAct)
         Print #intTarget, "<" & strTag & ">" & arrAct(intCounter) & "</" & strTag & ">"
      Next intCounter
      Print #intTarget, "</tr>"
      bln = True
   Loop
   Close intSource
   Print #intTarget, "</table></body></html>"
   Close intTarget
   Shell "hh " & ThisWorkbook.Path & "\TextImport.htm", vbMaximizedFocus
End Sub

Import zur Anzeige in einem Arbeitsblatt

Sub WriteInWks()
   Dim cln As New Collection
   Dim arrAct As Variant
   Dim intSource As Integer, intRow As Integer, intCol As Integer
   Dim txt As String
   Workbooks.Add
   intSource = FreeFile
   Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
   Do Until EOF(intSource)
      Line Input #intSource, txt
      arrAct = SplitString(txt, ",")
      intRow = intRow + 1
      For intCol = 1 To UBound(arrAct)
         Cells(intRow, intCol).Value = arrAct(intCol)
      Next intCol
   Loop
   Close intSource
   Rows(1).Font.Bold = True
End Sub

Import zur Übernahme in UserForm-Controls

In einem Standardmodul:

Public garr() As String
Public gint As Integer

Im Klassenmodul der UserForm:

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdWeiter_Click()
   Dim intCounter As Integer
   If gint <= 4 Then gint = gint + 1 Else gint = 1
   For intCounter = 1 To 5
      Controls("TextBox" & intCounter).Text = garr(gint, intCounter)
   Next intCounter
End Sub

Private Sub UserForm_Initialize()
   Dim arrAct As Variant
   Dim intSource As Integer, intCounter As Integer, intRow As Integer
   Dim txt As String
   Dim bln As Boolean
   gint = 0
   intSource = FreeFile
   Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
   Do Until EOF(intSource)
      Line Input #intSource, txt
      arrAct = SplitString(txt, ",")
      If bln = False Then
         For intCounter = 1 To UBound(arrAct)
            Controls("Label" & intCounter).Caption = _
               arrAct(intCounter) & ":"
         Next intCounter
         ReDim garr(1 To 5, 1 To UBound(arrAct))
      Else
         intRow = intRow + 1
         For intCounter = 1 To UBound(arrAct)
            garr(intRow, intCounter) = arrAct(intCounter)
         Next intCounter
      End If
      bln = True
   Loop
   Close intSource
End Sub

Für alle vorstehende Routinen wird die folgende benutzerdefinierte Funktion in einem Standardmodul benötigt (Die Funktion macht unabhängig von der erst ab XL2000 verfügbaren VBA-Funktion Split:

Function SplitString(ByVal txt As String, strSeparator As String)
   Dim arr() As String
   Dim intCounter As Integer
   Do
      intCounter = intCounter + 1
      ReDim Preserve arr(1 To intCounter)
      If InStr(txt, strSeparator) Then
         arr(intCounter) = Left(txt, InStr(txt, strSeparator) - 1)
         txt = Right(txt, Len(txt) - InStr(txt, strSeparator))
      Else
         arr(intCounter) = txt
         Exit Do
      End If
   Loop
   SplitString = arr
End Function