Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
600to604
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
600to604
600to604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Verkn. Löschen! Geht es denn wirklich nicht! Help!

Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 12:00:54
DonFiala
Hallo liebe Leut,

habe ein Makro dass ein Tabellenblatt in eine neue Datei kopiert, abspeichert und als Email Anhang versendet.
Leider kommt beim Empfänger immer die Frage nach der Aktualisierung! Egal ob man dann ja oder nein drückt, die Werte werden dann ersetz durch dieses komische Wert#! Zeichen oder so ähnlich und man kann nix mehr erkennen.
Habe ewig hier im Forum gesucht, aber nix funktionierendes gefunden. Entweder die Makros bringen Fehlermeldungen, oder sie bewirken nicht, d.h. bei Bearbeiten Verknüpfung steht immer noch die Verknüpfung zur Ursprungsquelle.
Wer is so super Freundlich und gibt mir ein Makro bzw. ergänz mein Makro damit es funktioniert, krieg langsam echt die Krise! Vielen Vielen Dank
P.S. bin ne absolute VBA Niete :-(
1000end Dank, Gruss michi

Sub emailManuell()
ActiveSheet.Copy
ActiveSheet.Unprotect "Passwort"
' Wartepopup Herber
Dim WsShell, Rück%
Set WsShell = CreateObject("WScript.Shell")
Rück = WsShell.Popup("Datei wird für Speicherung vorbereitet. Bitte einen Augeblick Geduld...", 5 _
, "Überschrift ...")
' Die 5 in der letzten Zeile gibt die Dauer der Öffnung an.
' Rück ist -1 wenn keine Taste gedrückt wurde
' Rück ist 1 wenn OK gedrückt wurde
' Herber Programm, FUNKTIONIERT ABER LEIDER NICHT!!!!!!!!!!!!!!!!!!!!!!!!
Dim Zelle As Range
'erste Verknüpfung finden
Set Zelle = Cells.Find(What:="]", LookIn:=xlFormulas)
If Not Zelle Is Nothing Then
Do
Zelle = Zelle.Value
Set Zelle = Cells.FindNext(Zelle)
Loop While Not Zelle Is Nothing
End If
Dim DName As String, Dateiname As String, Pfad As String
Pfad = Range("Y7")
DName = Range("V6")
Dateiname = Pfad & "\" & DName & Format(Range("G7"), "YYYY.MMM") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
'ActiveWorkbook.SaveAs Filename:=Dateiname
'ActiveSheet.Select
' ActiveWindow.Close SaveChanges:=0
On Error GoTo Fehler
ArbVerz = CurDir
ChDir Pfad
ChDir ArbVerz
ActiveWorkbook.SaveAs Filename:=Dateiname
MsgBox "Datei wurde erfolgreich unter dem Namen " & ActiveWorkbook.Name & " gespeichert."
'ActiveWorkbook.Close
'Exit Sub
'Makro "senden" aufrufen (call kannste weglassen)
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
Dim D2Name As String
D2Name = Range("V7")
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = Pfad & "\" & DName & Format(Range("G7"), "YYYY.MMM") & ".xls"
' AWS = ThisWorkbook.FullName
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = D2Name
' .To = "D2Name"
.Subject = "Zielerreichungsgespräch " '& Date
.attachments.Add AWS
'.Body = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
' OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
ActiveWorkbook.Close
Exit Sub
Fehler:
If Err.Number = 1004 Then
MsgBox "Datei nicht gespeichert"
Else
MsgBox Err.Description: 'Exit Sub
End If
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 12:58:38
Fred
Guten Tag,
Die neue Datei speichern mit:
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False
Application.CutCopyMode = False
Windows("**Dateiname**").Activate: ActiveWorkbook.Save
dann sollten keine Verknüpfungen mehr sein.
Fred
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 13:14:46
DonFiala
Hallo Fred,
leider weiss ich nicht wo ich Deine 3 Zeilen einfügen muss. Aber der Befehl den Du angibts ist glaub so ähnlich wie der Werte einfügen Befehl? Der würde leider nicht klappen, weil ich viele Verbundene Zellen habe und Excel dann eine Fehlermeldung bring, dass für diese Operation alle Zellen die selbe Grösse haben müssen (oder so ähnlich zumindest)
Vielen Dank für Deine Hilfe, Gruss michi
Anzeige
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 13:23:02
Dietlinde
Hi DonFiala
hier ein kleiner Ansatz, musst nur ein bischen anpassen:

Sub Blatt_CopySave()
Ablage = Speichername   'hier musst du tätig werden
Application.EnableEvents = False
Application.SheetsInNewWorkbook = 1
Cells.Copy
Workbooks.Add
With ActiveSheet
.Paste
With Cells
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End With
Application.CutCopyMode = False
Application.SheetsInNewWorkbook = 3
NamenLoeschen
On Error GoTo ERRORHANDLER
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Ablage, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=True, CreateBackup:=False
MailSend
ActiveWorkbook.Close savechanges:=False
MsgBox "Mitteilung an XXXX wurde gespeichert, Speicherort und Speichername: " & Chr(10) & ThisWorkbook.Path & "\" & Chr(10) & Ablage, vbInformation, "Speicherung"
If Fehler = False Then
MsgBox "Mitteilung an XXXX per EMail versendet", vbInformation, "Mitteilung senden"
Else
MsgBox "EMail wurde nicht abgeschickt ", vbInformation, "Mitteilung senden"
End If
Application.EnableEvents = True
Exit Sub
ERRORHANDLER:
MsgBox "Die Datei konnte nicht gespeichert werden!"
Application.EnableEvents = True
End Sub



Sub MailSend()
Dim RecipArray As Variant
Fehler = False
RecipArray = Array("Otto.weissnicht@t-online.de", _   'hier musst du anpassen
"Herbert.Ichnix@t-online.de")
If Application.MailSystem <> xlNoMailSystem Then
On Error GoTo MailError
ActiveWorkbook.SendMail _
Recipients:=RecipArray, _
Subject:=Ablage, _
returnReceipt:=True
Else
MsgBox "Kein Mail-System installiert."
Exit Sub
End If
Exit Sub
MailError:
Fehler = True
End Sub



Sub NamenLoeschen()
Dim nmeAct As Object
'   For Each nmeAct In ThisWorkbook.Names
For Each nmeAct In ActiveWorkbook.Names
nmeAct.Delete
Next nmeAct
End Sub


Rückmeldung wäre nett!
Grüsse Dietlinde
Anzeige
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 14:10:23
DonFiala
Hallo Dietlinde,
das is wirklich sehr nett von Dir, dass Du Dir gleich so viel Arbeit machst. Nur leider bin ich viel zu schlecht um sowas anzupassen, kann VBA praktisch nicht! Aber eigentlich funtioniert mein Makro ja mit all den beschriebenen Eigenschaften sehr gut, nur das eben das Verknüpfungen entfernen noch nicht klappt! Wenn Du das was wüsstest, das wäre Spitze! Vielen Dank, Gruss michi
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 16:52:29
Dietlinde
Hi DonFiala
ich hoffe, du bist des Lesens kundig, dann wäre dir sicherlich das Makro:
Namenloeschen, steht ganz am Ende, aufgefallen.
Versuch's doch mal bei Fielmann
Grüsse Dietlinde
für heute ist Feierabend!
Anzeige
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 17:06:57
DonFiala
Hallo,
bin des lesens kundig, aber da wie ich geschrieben habe mein Makro an sich gut funktioniert und ich nur was brauch was verknüpfungen löscht und an der richtigen Stelle in meinem Makro, bringt mich Dein grosses Makro mit dem Hinweis auf Editieren nicht weiter, da ich ja, wie erwähnt in VBA ne Null bin. Und da ich gesehen habe das in Deinem Makro Dinge beschrieben werden die ich schon habe, habe ich nicht alles gelesen, da mir das eh nix sagt. Die von Dir erwähnte Zeile habe ich an ne Stelle kopiert an der ich denke, dass es hingehört, hat aber au nix gebracht...
Trotzdem Vielen Dank, Gruss michi
Anzeige
AW: Verkn. Löschen! Geht es denn wirklich nicht! Help!
23.04.2005 19:18:03
andre
Hallo Michi,
mit diesem code kannst Du Verknüpfungen in Formeln trennen. Die Mappen wo die Formeln ihre Daten holen sollten dabei aber geschlossen sein sonst wird's nix.

Sub XLS_Verknüpfung_Trennen()
For Each zellen In Sheets(1).UsedRange
If zellen.HasFormula Then
If InStr(1, zellen.Formula, "xls") > 1 Then
zellen.Copy
On Error Resume Next
zellen.PasteSpecial xlValues
On Error GoTo 0
End If
End If
Next
End Sub

Verknüpfungen können auch an anderer Stelle sein, diese werden mit diesem code nicht entfernt.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige