VBA-Code optimieren
18.03.2004 22:42:37
Ingo Siemon
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 i 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") & """> </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) & "<br>" & Cells(iRow, 24) & IIf(Limitiert <> "", """<br>""( 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