hi Danny!
wenn ich dein problem richtig verstanden habe dann versuchs mal hiermit:
du benötigst folgende steuerelemente je 1x:
- CommandButton
- DriveListBox
- DirListBox
- FileListBox
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Dim sd As String
Private Sub Command1_Click()
pfad = File1.Path
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
For html = 0 To File1.ListCount - 1
Open pfad & Left(File1.List(html), InStrRev(File1.List(html), ".")) & _
"html" For Output As #1
Print #1, "<html><head><title>" & File1.List(html) & _
"</title></head><body topmargin=" & Chr(34) & "0" & Chr(34) & "" & _
"leftmargin=" & Chr(34) & "0" & Chr(34) & " bgproperties=" & Chr(34) & _
"fixed" & Chr(34) & " background=" & Chr(34) & File1.List(html) & Chr(34) & _
"><p>"
If File1.ListCount > 1 Then
Select Case html
Case 0
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & File1.List(File1.ListCount - 1) & " <--" & _
"Zurück" & Chr(34) & " name=" & Chr(34) & "B1" & Chr(34) & "" & _
"onClick=" & Chr(34) & "window.location.href='" & Left( _
File1.List(File1.ListCount - 1), InStrRev(File1.List( _
File1.ListCount - 1), ".")) & "html'" & Chr(34) & ">"
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & "Weiter --> " & File1.List(html + 1) & _
Chr(34) & " name=" & Chr(34) & "B2" & Chr(34) & " onClick=" & _
Chr(34) & "window.location.href='" & Left(File1.List(html + 1), _
InStrRev(File1.List(html + 1), ".")) & "html'" & Chr(34) & ">"
Case File1.ListCount - 1
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & File1.List(html - 1) & " <-- Zurück" & _
Chr(34) & " name=" & Chr(34) & "B1" & Chr(34) & " onClick=" & _
Chr(34) & "window.location.href='" & Left(File1.List(html - _
1), InStrRev(File1.List(html - 1), ".")) & "html'" & Chr(34) _
& ">"
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & "Weiter --> " & File1.List(0) & Chr(34) _
& " name=" & Chr(34) & "B2" & Chr(34) & " onClick=" & Chr(34) & _
"window.location.href='" & Left(File1.List(0), InStrRev( _
File1.List(0), ".")) & "html'" & Chr(34) & ">"
Case Is > 0
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & File1.List(html - 1) & " <-- Zurück" & _
Chr(34) & " name=" & Chr(34) & "B1" & Chr(34) & " onClick=" & _
Chr(34) & "window.location.href='" & Left(File1.List(html - _
1), InStrRev(File1.List(html - 1), ".")) & "html'" & Chr(34) _
& ">"
Print #1, "<input type=" & Chr(34) & "button" & Chr(34) & "" & _
"value=" & Chr(34) & "Weiter --> " & File1.List(html + 1) & _
Chr(34) & " name=" & Chr(34) & "B2" & Chr(34) & " onClick=" & _
Chr(34) & "window.location.href='" & Left(File1.List(html + 1), _
InStrRev(File1.List(html + 1), ".")) & "html'" & Chr(34) & ">"
End Select
End If
Print #1, "</p></body></html>"
Close #1
Next
URLGoTo Me.hWnd, pfad & Left(File1.List(0), InStrRev(File1.List(0), ".")) & _
"html"
End
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
If File1.ListCount > 0 Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Drive1_Change()
On Error GoTo fehler
Dir1.Path = Drive1.Drive
sd = Drive1.Drive
Exit Sub
fehler:
Drive1.Drive = sd
Resume Next
End Sub
Private Sub Form_Load()
File1.Pattern = "*.bmp;*.jpg;*.gif;*.jpeg"
Command1.Caption = "Seiten erstellen und anzeigen"
sd = Drive1.Drive
End Sub
Public Sub URLGoTo(ByVal hWnd As Long, ByVal URL As String)
Screen.MousePointer = 11
Call ShellExecute(hWnd, "Open", URL, "", "", 1)
Screen.MousePointer = 0
End Submfg
brave@heart
...bis zur unendlichkeit und noch viel weiter... |
Forenübersicht Suchen Forumsregeln
Oktober 2025
Sie sind aktuell nicht angemeldet.
