Shapes löschen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Shapes löschen
von: Wolf Ludwig
Geschrieben am: 04.09.2015 10:25:18

Hallo Michael,
es tut mir leid das ich mich jetzt erst melde, aus der Reha kam ich nochmal in das Krankenhaus.
Jetzt geht es mir wieder besser und konnte mich auch ausgiebig mit Deinem letzten Script befassen.
Es ist jetzt die richtige Richtung, allerdings müsste noch etwas verändert werden.
Ich brauche nur Temp1 - ohne X-Dateien.
Davon Sheet001, HTM-Datei, allerdings diese als reine html-Datei, so wie es das Script von
Josef Ehrensberger liefert. Alles andere was in Temp1 noch drin ist, ist nicht notwendig.
Wenn dann das so in der Form in das Script von Sepp eingebaut wird, wäre ich happy.
Dir einen schönen Tag
Wolf


Sub DownloadFiles()
Dim lngResult As Long, lngRow As Long, lngLast As Long
Dim strFolder As String, strError As String
strFolder = "C:\Users\Wolf Ludwig\Documents\Download" 'Zielverzeichnis - Anpassen
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
lngLast = Cells(Rows.Count, 2).End(xlUp).Row
For lngRow = 1 To lngLast
  lngResult = URLDownloadToFile(0, Cells(lngRow, 3), strFolder & Cells(lngRow, 2) & ".html", 0,  _
 _
 _
0)
  If lngResult <> 0 Then
    strError = strError & Cells(lngRow, 3) & vbLf
  End If
Next
If Len(strError) > 0 Then
  MsgBox "Folgende Dateien konnten nicht geladen werden!" & vbLf & vbLf & _
    strError, vbInformation, "Hinweis"
End If
End Sub

Bild

Betrifft: AW: Shapes löschen
von: Michael
Geschrieben am: 04.09.2015 22:10:52
Hallo Wolf,
irgendwie habe ich das Gefühl, wir reden nur aneinander vorbei.
Ich hatte gehofft, Dir klar zu machen, daß das Skript vom Josef KEINE Möglichkeiten des Eingriffs bietet, derweil der Befehl

URLDownloadToFile

die komplette HTML-Datei kopiert und speichert.
Funktioniert denn der Code hier:
Public Sub machs()
    Dim WB As Workbook
    Dim shp As Shape
Set WB = Workbooks.Open("https://www.herber.de/autor.html")
    With WB
        .SaveAs "C:\Dein_Ordner\Download\Herber_mit_X.xls"
        .SaveAs "C:\Dein_Ordner\Download\Herber_mit_H.htm"
    ' ********************************* von hier ***********************
      For Each shp In .ActiveSheet.Shapes
        shp.Delete
      Next
    ' **** bis hier werden alle Shapes gelöscht ************************
        .SaveAs "C:\Dein_Ordner\Download\Herber_ohne_X.xls"
        .SaveAs "C:\Dein_Ordner\Download\Herber_ohne_H.htm"
        .Close True
    End With
End Sub
Wenn ja, dann brauchst Du nur die drei Zeilen mit den ersten .SaveAs auszukommentieren, so daß nur die unterste .SaveAs - Zeile stehen bleibt, mit der HTM *ohne* die Shapes gespeichert wird.
WENN das zufriedenstellend funktioniert, kann man wiederum die Schleife drumherumbauen.
Schöne Grüße,
Michael

Bild

Betrifft: AW: Shapes löschen
von: Wolf Ludwig
Geschrieben am: 07.09.2015 12:48:15
Hallo Michael,
Danke für Deine nochmalige Mühe und Nachricht.
Ich habe zum Glück eine Lösung für das Shapes Problem gefunden.
Mit einem Externen Programm "Suchen und Ersetzen" kann ich im
Quellcode der html-Seiten die "image-gif" dateiübergreifend löschen.
Das geht einfach und ratzfatz.
In einem Punkt möchte ich Dich nocheinmal um Deine Hilfe bitten.
Bei mir ist immer noch das Problem, einzelne html-Dateien in einzelne
Windows Ordner verschieben offen. Ich habe im HERBER-Archiv etwas gefunden,
aber damit kann ich nichts anfangen, vielleicht kannst Du mir da weitehelfn.
https://www.herber.de/forum/archiv/648to652/t648877.htm
Nochmals Danke und einen schönen Tag
Wolf

Bild

Betrifft: wer anders bitte - nur aus Zeitmangel
von: Michael
Geschrieben am: 08.09.2015 11:24:09
Hallo Wolf,
Du hattest ja im ersten Thread eine Datei hochgeladen, in der Sepps Code sich die Infos zur URL aus Spalte C und den Dateinamen zum Speichern aus Spalte B geholt hat.
Wie stellst Du Dir das mit "in einzelne Ordner verschieben" vor? Willst Du das gleich beim Herunterladen erledigen?
Dann kannst Du übrigens in Spalte B weitere Unterordner vor den Dateinamen angeben, z.B. statt jetzt import.html einfach weitererOrder\import.html
Das wird dann an den vorhandenen Pfad ...

strFolder = "C:\Users\Wolf Ludwig\Documents\Download"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

... angehängt und speichert dann so:
C:\Users\Wolf Ludwig\Documents\Download\weitererOrder\import.html
Oder soll das ein extra Programm sein?
Schöne Grüße,
Michael

Bild

Betrifft: sorry, falscher Betreff owT
von: Michael
Geschrieben am: 08.09.2015 16:53:57


Bild

Betrifft: AW: sorry, falscher Betreff owT
von: Wolf Ludwig
Geschrieben am: 08.09.2015 21:09:30
Guten Abend Michael,
Ich wäre Dir dankbar, wenn Du es als extra Programm machen könntest. Ich brauche die Dateien einmal im gesamten und einmal je eine im einzelnen Ordner. Dateiname soll gleich Ordnername sein.
Viren Dank im voraus.
Wolf

Bild

Betrifft: AW: sorry, falscher Betreff owT
von: Michael
Geschrieben am: 09.09.2015 14:35:11
Hallo Wolf,
wie vernagelt man sein kann...
So habe ich mir den Code vorgestellt:

Sub kopieren()
Dim von$, nach$, name$, ohneExt$
Dim punkt&
von = Range("C2").Value
If Right(von, 1) <> "\" Then von = von & "\"
nach = Range("C4").Value
If Right(nach, 1) <> "\" Then nach = nach & "\"
If von = nach Then
  MsgBox "Pfade müssen unterschiedlich sein!"
  End
End If
'' Für ALLE Datein im Ordner
'name = Dir(von, vbNormal)
' ODER nur für *.htm*:
name = Dir(von & "*.htm*", vbNormal)
While name <> ""
 ' für Ordnernamen OHNE Extension, also ohne das .HTM(L)
  punkt = InStrRev(name, ".")
  ohneExt = Mid(name, 1, punkt - 1)
  MkDir nach & ohneExt
  FileCopy von & name, nach & ohneExt & "\" & name
' ' oder MIT Extension:
'  MkDir nach & name
'  FileCopy von & name, nach & name & "\" & name
' ' MIT Extension Ende
  name = Dir
Wend
End Sub

... aber er hat auf Anhieb (ohne If von = nach Then) nicht funktioniert.
Warum? Weil kein Ordner mit dem gleichen Namen wie eine bereits vorhandene Datei angelegt werden kann.
Also: bitte unterschiedliche Ordner verwenden. Oder gleiche Ordner, aber mit Verzeichnisnamen OHNE Extension.
In C2 gibst Du den kompletten Pfad ein, in dem sich die Datein befinden, in C4 den Ordner, in dem die neuen Ordner samt Datei-Kopien angelegt werden sollen.
Der Code ist kurz getestet, aber ohne Errorhandling. Interessant ist in dem Zusammenhang auch:
http://www.office-loesung.de/ftopic585400_0_0_asc.php
Dort werden API- anstatt der eingebauten Excel-Funktionen verwendet.
Schöne Grüße,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Shapes löschen"