Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
400to404
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
400to404
400to404
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA-Code optimieren

VBA-Code optimieren
18.03.2004 22:42:37
Ingo Siemon
Guten Abend allerseits :)
Ich poste hier mal meinen VBA-Code, den ich benutze
um merere shtml- und Text-Dateien aus den Daten
einer Excel-Tabelle zu "generieren"
Da ich selber keine große Ahnung von VBA habe,
möchte ich Euch an dieser Stelle um Rat fragen,
ob man das noch verbessern kann.
Ich habe das alles in einem einigen Modul stehen
und zwar exact so, wie hier gepostet.
Über Eure Ratschläge würde ich mich riesig freuen.
Gruß aus Münster
Ingo

Und hier nun der Code:
-----------------------------------------------------------------------------


Option Explicit
Public Artikel_Zurück As String
Public Artikel_Vor As String
Public Einzelstück As String
Public Limitiert As String
Public Datum As String
Public bolAbbruch As Boolean
Sub NEUER_ARTIKEL()
   Dim iFile As Integer
   Dim iRow As Integer
   Dim iAnz As Integer
   Dim As Integer
   Dim petFile As String
   UserForm1.Show
   If bolAbbruch Then Exit Sub
   iFile = FreeFile
   iRow = ActiveCell.Row
   petFile = Cells(iRow, 22) & ".shtml"
   Open "D:\SPACEart\Bilder-Rename\" & petFile For Output As iFile
     Print #iFile, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
     Print #iFile, ""
     Print #iFile, "<html>"
     Print #iFile, "<head>"
     Print #iFile, ""
     Print #iFile, "<title>" & Cells(iRow, 3) & ", " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "</title>"
     Print #iFile, "<!--<webindex><span style=""font-weight:bold"">" & Cells(iRow, 3) & "</span>, " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "</webindex>-->"
     Print #iFile, ""
     Print #iFile, "<link rel=stylesheet type=""text/css"" href=""../css.css"">"
     Print #iFile, ""
     Print #iFile, "<script language=""JavaScript"" src=""dazu.js"" type=""text/javascript""></script>"
     Print #iFile, ""
     Print #iFile, "<meta http-equiv=""imagetoolbar"" content=""no"">"
     Print #iFile, "<meta http-equiv=""expires"" content=""43200"">"
     Print #iFile, "<meta name=""revisit-after"" content=""7 days"">"
     Print #iFile, ""
     Print #iFile, "<SCRIPT language=""JavaScript"" type=""text/javascript"">"
     Print #iFile, "<!--"
     Print #iFile, " function checkFrameset() {"
     Print #iFile, "  if(!parent.inhalt)"
     Print #iFile, "   location.href=""http://www.SPACEart.de/index.htm?"" + location.href;"
     Print #iFile, " }"
     Print #iFile, "//-->"
     Print #iFile, "</SCRIPT>"
     Print #iFile, ""
---[HIER HABE ICH MAL EIN PAAR PRINT-ZEILEN AUGESCHNITTEN; DAMIT ES NICHT ZU LANG FÜRS POSTING WIRD]---
     Print #iFile, ""
     Print #iFile, "<!-- Leerzeile [Anfang] -->"
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=20 alt=""""></td></tr></table>"
     Print #iFile, "<!-- Leerzeile [Ende] -->"
     Print #iFile, ""
     Print #iFile, "</body>"
     Print #iFile, "</html>"
   Close iFile
   iFile = FreeFile
   iRow = ActiveCell.Row
   petFile = "neu-" & Cells(iRow, 22) & ".shtml"
   Open "D:\SPACEart\Bilder-Rename\" & petFile For Output As iFile
     Print #iFile, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
     Print #iFile, ""
     Print #iFile, "<html>"
     Print #iFile, "<head>"
     Print #iFile, ""
     Print #iFile, "<title>" & Cells(iRow, 3) & ", " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "</title>"
     Print #iFile, "<!--<webindex><span style=""font-weight:bold"">" & Cells(iRow, 3) & "</span>, " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "</webindex>-->"
     Print #iFile, ""
---[HIER HABE ICH MAL EIN PAAR PRINT-ZEILEN AUGESCHNITTEN; DAMIT ES NICHT ZU LANG FÜRS POSTING WIRD]---
     Print #iFile, ""
     Print #iFile, "<!-- Modell [Anfang] -->"
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=10 alt=""""></td></tr></table>"
     Print #iFile, "<table class=""weiss"" border=0 cellspacing=0 cellpadding=0 width=510>"
     Print #iFile, "<tr><td>"
     Print #iFile, "        <table border=0 cellspacing=1 cellpadding=2 width=""100%"">"
     Print #iFile, "        <tr>"
     Print #iFile, "        <td class=""u2"">" & Cells(iRow, 3) & Einzelstück & "</td>"
     Print #iFile, "        </tr>"
     Print #iFile, "        </table>"
     Print #iFile, "</td></tr>"
     Print #iFile, "</table>"
     Print #iFile, ""
   iAnz = CInt(Cells(iRow, 36))
   For i = 1 To iAnz
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=1 alt=""""></td></tr></table>"
     Print #iFile, "<table class=""weiss"" border=0 cellspacing=0 cellpadding=0 width=510>"
     Print #iFile, "<tr><td>"
     Print #iFile, "        <table border=0 cellspacing=1 cellpadding=0 width=""100%"">"
     Print #iFile, "        <tr>"
     Print #iFile, "        <td class=""dunkel""><img src=""../Artikel/" & LCase(Cells(iRow, 2)) & "-" & Chr$(96 + i) & ".jpg"" width=508 height=300 alt=""" & Cells(iRow, 3) & ", " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & """ title=""" & Cells(iRow, 3) & ", " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & """></td>"
     Print #iFile, "        </tr>"
     Print #iFile, "        </table>"
     Print #iFile, "</td></tr>"
     Print #iFile, "</table>"
     Print #iFile, ""
   Next i
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=6 alt=""""></td></tr></table>"
     Print #iFile, "<table class=""weiss"" border=0 cellspacing=0 cellpadding=0 width=510>"
     Print #iFile, "<tr><td>"
     Print #iFile, "        <table border=0 cellspacing=1 cellpadding=2 width=""100%"">"
     Print #iFile, "        <tr>"
     Print #iFile, "        <td class=""dunkel"" width=320><p class=""links"">" & Cells(iRow, 8) & "</p></td>"
     Print #iFile, "        <td class=""dunkel"" width=160><p class=""rechts"">Preis : " & Cells(iRow, 6) & ",- EUR</p></td>"
     Print #iFile, "        <td class=""dunkel"" width=13><p class=""mitte""><a href=""http://www.xe.com/pca/"" onFocus=""this.blur()""><img src=""../dollar.gif"" border=0 alt=""Currency Converter"" title=""Currency Converter""></a></p></td>"
     Print #iFile, "        </tr>"
     Print #iFile, "        </table>"
     Print #iFile, "</td></tr>"
     Print #iFile, "</table>"
     Print #iFile, ""
---[HIER HABE ICH MAL EIN PAAR PRINT-ZEILEN AUGESCHNITTEN; DAMIT ES NICHT ZU LANG FÜRS POSTING WIRD]---
     Print #iFile, ""
     Print #iFile, "<!-- Leerzeile [Anfang] -->"
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=20 alt=""""></td></tr></table>"
     Print #iFile, "<!-- Leerzeile [Ende] -->"
     Print #iFile, ""
     Print #iFile, "</body>"
     Print #iFile, "</html>"
   Close iFile
   petFile = "Liste_NEU.txt"
   Open "D:\SPACEart\Bilder-Rename\" & petFile For Output As iFile
   iRow = ActiveCell.Row
     Print #iFile, "<!-- Artikel [Anfang] -->"
     Print #iFile, "<table><tr><td><img src=""../blind.gif"" height=10 alt=""""></td></tr></table>"
     Print #iFile, "<table class=""weiss"" border=0 cellspacing=0 cellpadding=0 width=510>"
     Print #iFile, "<tr><td>"
     Print #iFile, "        <table border=0 cellspacing=1 cellpadding=2 width=""100%"">"
     Print #iFile, "        <tr>"
     Print #iFile, "        <td class=""u2"">" & Datum & "." & Format(Date, "mm.yyyy") & "<a name=""" & Datum & Format(Date, "mmyyyy") & """>&nbsp;</a></td>"
     Print #iFile, "        </tr>"
     Print #iFile, "        </table>"
     Print #iFile, "</td></tr>"
     Print #iFile, "</table>"
     Print #iFile, ""
     Print #iFile, "<table border=0 cellspacing=0 cellpadding=0 width=510><tr><td colspan=3><img src=""../blind.gif"" height=6 alt=""""></td></tr>"
     Print #iFile, "<tr onmouseover=""this.bgColor='#004559';"" onmouseout=""this.bgColor='#235F70';"" onClick=""location.href='../Neue-Artikel/neu-" & Cells(iRow, 22) & ".shtml'"" style=""cursor:pointer;cursor:hand;""><td width=154><table class=""weiss"" border=0 cellspacing=0 cellpadding=0 width=152><tr><td><table border=0 cellspacing=1 cellpadding=0 width=""100%""><tr><td class=""hell"" style=""background-image:url(../Galerie/h.gif)""><a href=""../Neue-Artikel/neu-" & Cells(iRow, 22) & ".shtml"" onFocus=""this.blur()""><img src=""../Artikel/thumb_" & Cells(iRow, 22) & "-" & Cells(iRow, 23) & ".jpg"" border=0 width=150 height=89 alt="""" title=""""></a></td></tr></table></td></tr></table></td><td><img src=""../blind.gif"" width=6 alt=""""></td>"
     Print #iFile, "<td width=400 style=""vertical-align:bottom;""><p class=""links""><a href=""../Neue-Artikel/neu-" & Cells(iRow, 22) & ".shtml"" onFocus=""this.blur()"">" & IIf(Einzelstück = "(Einzelstück)", "<span style=""font-weight:bold;color:#FFFF00"">EINZELSTÜCK ( VORRÄTIG !!! )</span><br>", "") & "<span style=""font-weight:bold"">" & Cells(iRow, 3) & "</span><br>" & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & IIf(Limitiert <> "", "<br><img src=""../blind.gif"" height=1 width=1 alt="""" border=0><span style=""font-weight:bold;font-size:8pt"">( Limitiert auf weltweit nur " & Limitiert & " Exemplare ! )</span>", "") & "</a></p></td><tr></table>"
     Print #iFile, "<!-- Artikel [Ende] -->"
   Close iFile
   petFile = "Liste.txt"
   Open "D:\SPACEart\Bilder-Rename\" & petFile For Output As iFile
   iRow = ActiveCell.Row
     Print #iFile, "<table border=0 cellspacing=0 cellpadding=0 width=510>"
     Print #iFile, "<tr><td><img src=""../blind.gif"" height=6 alt=""""></td></tr>"
     Print #iFile, "<tr onmouseover=""this.bgColor='#004559';"" onmouseout=""this.bgColor='#235F70';""><td valign=""top"">"
     Print #iFile, "        <p class=""links""><img src=""../blind.gif"" height=1 width=1 alt=""""><a href=""../Artikel/" & Cells(iRow, 22) & ".shtml"" onFocus=""this.blur()""><span style=""font-weight:bold"">" & Cells(iRow, 3) & "</span>, " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & IIf(Einzelstück = "(Einzelstück)", "<img src=""../blind.gif"" height=1 width=10 alt="""" border=0><span style=""font-weight:bold;font-size:8pt;color:yellow;"">EINZELSTÜCK</span>", "") & IIf(Limitiert <> "", "<br><img src=""../blind.gif"" height=1 width=10 alt="""" border=0><span style=""font-weight:bold;font-size:8pt"">( Limitiert auf weltweit nur " & Limitiert & " Exemplare ! )</span>", "") & "</a></p>"
     Print #iFile, "    </td>"
     Print #iFile, "</tr>"
     Print #iFile, "</table>"
   Close iFile
   petFile = "RSS.txt"
   Open "D:\SPACEart\Bilder-Rename\" & petFile For Output As iFile
   iRow = ActiveCell.Row
     Print #iFile, "<item>"
     Print #iFile, "<title>SPACEart - " & Cells(iRow, 3) & ", " & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "</title>"
     Print #iFile, "<description>" & Cells(iRow, 8) & ", " & Cells(iRow, 4) & ", " & Cells(iRow, 5) & "&lt;br&gt;" & Cells(iRow, 24) & IIf(Limitiert <> "", """&lt;br&gt;""( Limitiert auf weltweit nur " & Limitiert & " Exemplare ! )", "") & "</description>"
     Print #iFile, "<link>" & Cells(iRow, 28) & "</link>"
     Print #iFile, "</item>"
   Close iFile
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Code optimieren
19.03.2004 09:31:32
Hans W. Hofmann
Hallo Ingo!
Grundsätzlich sind solche Kontruktionen sehr schlecht zu warten.
Ich würde entsprechende Musterdateien anlegen und an den zu patchenden Stellen eindeutige Pattern hinterlegen. Die Files einlesen das Pattern suchen und ersetzen...
PS: Vielen Dank, dass Du nicht die Linux Kernel Sourcen gepostet hast ;-)...

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige