Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1328to1332
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
Inhaltsverzeichnis

Beim Speichern Makro starten

Beim Speichern Makro starten
13.09.2013 14:03:21
Pamela
Guten Tag liebe VBA-Profis
https://www.herber.de/bbs/user/87282.xlsm
In einer Excel Arbeitsmappe hab ich eine Auflistung verschiedener Datensätze und Links.
Die Arbeitsmappe wird laufend um neue Einträge erweitert.
Nun möchte ich mittels Makro folgendes bewerkstelligen:
Bei jedem Speichern des Tabellenblatts Tabelle1 soll bei allen vorhandenen Datensätzen geprüft werden, ob in
der Spalte "D" ein Hyperlink dasteht. Wenn ja, dann soll geprüft werden, ob in diesem Hyperlink eine Dateiendung steht.
Wenn ja, dann soll die Datei-Endung in die Spalte P geschrieben werden.
Wenn nein, dann steht in Spalte P eben nichts.
Leider reicht mein Wissen wohl nicht, um aus folgendem Code (bloss ne Idee) etwas brauchbares zu basteln.
Daher erhoff ich mir Hilfe.
Vielen Dank
Private Sub Worksheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
With ActiveSheet
For liRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
'wenn in der gerade aktuellen Zeile in der Zelle in Spalte D ein Wert steht,...
If .Range("D" & liRow).Hyperlinks.Count = 1 Then
'...dann wird aus dem Hyperlink der Dateityp ermittelt.
'Hyperlink-prüfen ob Dateiendung drin
End If
Next
End With
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Beim Speichern Makro starten
13.09.2013 14:33:54
Rudi
Hallo,
wie willst du feststellen, ob der HL eine Dateiendung hat? Ein . ist ist fast jedem HL.
Per Vergleichsliste:
Private Sub Worksheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objHyp As Hyperlink, arrEndung, strEnde, strMatch As String
arrEndung = Array(".xls", ".xlsx", ".xlsm", ".doc", ".pdf", ".ppt") 'anpassen
With ActiveSheet
For Each objHyp In .Hyperlinks
strMatch = objHyp.TextToDisplay
strEnde = Right(strMatch, Len(strMatch) - InStrRev(strMatch, ".") + 1)
If Not IsError(Application.Match(strEnde, arrEndung, 0)) Then
.Cells(objHyp.Range.Row, 16) = strEnde
End If
Next
End With
End Sub

Gruß
Rudi

Anzeige
AW: Beim Speichern Makro starten
13.09.2013 14:36:02
Pamela
Guten Nachmittag Herr Rudi
Danke für Ihre Antwort. Ich werde Ihre Möglichkeit gleich mal rauskopieren und mir in Ruhe anschauen.

AW: Beim Speichern Makro starten
13.09.2013 14:54:26
Pamela
nun hab ich den obigen Code von Herrn Rudi mal in ein Modul1 meiner Mappe kopiert. Beim Speichern meiner Mappe wird nun aber nicht der Code gestartet. Ich erhalte nur eine Dateschutz-Meldung, dass die vorliegende Arbeitsmappe Makros und ActiveX - Elemente enthalte. (Datei ist als XLSM gespeichert).
Wie starte ich den Code von Herrn Rudi nun?

Herr Rudi
13.09.2013 15:29:22
Rudi
Hallo Pamela,
im Forum herrscht das du.
Der Code muss unter 'DieseArbeitsmappe' stehen, nicht in einem Modul.
Gruß
(Herr) Rudi

Anzeige
AW: Herr Rudi
13.09.2013 15:40:48
Pamela
Hallo Rudi
(nun bin ich schon etwas verlegen :-)
Ich habe den Code nun gezügelt zu "DieseArbeitsmappe"
Beim Versuch das Tabellenblatt zu speichern erscheint immer noch die Datenschutzmeldung. Dein Makro startet nicht.
https://www.herber.de/bbs/user/87285.xlsm
Was mach ich falsch?
Pamela

AW: Herr Rudi
13.09.2013 16:30:38
Pamela
Hallo nochmals
Endlich brachte ich das Programm von Rudi zum laufen. Ich musste dazu die Code-Zeilen auf jedes meiner Tabellenblätter kopieren und zudem in meinem Excel die Makro-Sicherheitseinstellungen ändern.
Eine Frage bleibt mir aber dennoch:
Im Moment hat meine Excel-Datei total 24 Tabellenblätter. Ich habe nun das Programm von Rudi hinter jedes Tabellenblatt kopiert. Das funktioniert tadellos.
Allerdings ist davon auszugehen, dass in Zukunft noch weitere Dateiendungen hinzukommen und auch die Datei noch mehr Tabellenblätter erhalten wird.
Muss ich da künftig also hinter jedes neuangelegte Tabellenblatt ebenfalls dieses Programm kopieren oder kann ich dieses Programm irgendwo zentral ablegen (und mit jedem Tabellenblatt drauf verweisen)
Ich dachte da so an eine Lösung:
Code in ein Modul und mit jedem Tabellenblatt darauf zugreifen?
Geht das?
wenn ja, dann könnte ich künftig die Dateiendungen an einer Stelle ändern und schon funktioniert dies gleich auf allen Tabellenblätter wieder.
Pamela

Anzeige
AW: Herr Rudi
14.09.2013 13:48:58
UweD
Hallo Pamela
in der ersten Frage hattest du nur von Tabellenblatt1 geschrieben.
Jetzt möchtest du, das alle Tabellenblätter geprüft werden.
dazu das geänderte Makro in DieseArbeitsmappe kopieren.
Aus den einzelnen Tabellenblätters das Alte löschen.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objHyp As Hyperlink, arrEndung, strEnde, strMatch As String, TB
arrEndung = Array(".xls", ".xlsx", ".xlsm", ".doc", ".pdf", ".ppt") 'anpassen
For Each TB In Worksheets
With TB
For Each objHyp In .Hyperlinks
strMatch = objHyp.TextToDisplay
strEnde = Right(strMatch, Len(strMatch) - InStrRev(strMatch, ".") + 1)
If Not IsError(Application.Match(strEnde, arrEndung, 0)) Then
.Cells(objHyp.Range.Row, 16) = strEnde
End If
Next
End With
Next
End Sub
Gruß UweD

Anzeige
AW: Herr Rudi
16.09.2013 13:41:31
Pamela
Hallo UweD
Besten Dank für das Programm. Ich hab mir das soeben mal kopiert und werde es gleich mal testen.
Gruss
Pamela

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige