Hyperlink setzen ALEX.K

Sub SucheButton() Dim shp As Shape Dim sh As Worksheet Dim book As Workbook For Each book In Workbooks For Each sh In book.Sheets For Each shp In sh.Shapes If shp.Type = msoAutoShape Then If shp.DrawingObject.Caption = "Vormonat" Then shp.DrawingObject.Caption = "Aktuell" End If End If Next shp Next sh Next book End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub SucheButton()
Dim shp As Shape
Dim sh As Worksheet
Dim book As Workbook

For Each book In Workbooks
For Each sh In book.Sheets
For Each shp In sh.Shapes
If shp.Type = msoAutoShape Then
If shp.DrawingObject.Caption = "Vormonat" Then
shp.DrawingObject.Caption = "Aktuell"
sh.Hyperlinks.Add shp, "C:\Neu.xls"
End If
End If
Next shp
Next sh
Next book
End Sub

Hallo Alex
es ist sehr nett von dir dass du dich damit befasst. Ich bin der Meinung ich öffne die Datei vor der ganzen Prozedur, aber es will einfach nicht. Was mache ich falsch ?


Sub Sichern()
Dim AlterName, Neuername
Dim Button   As Shape
Dim Sh       As Worksheet
Dim Book     As Workbook
Dim Datei    As String
Datei = "c:\Excel\Vormonat"
On Error GoTo Meldung
Monat = Month(Now)
If Day(Now) - 15 <= 10 Then
Monat = Monat - 1
End If
If Monat - 2 < 1 Then
Archivmonat = Monat - 2 + 12
Archivjahr = Year(Now) - 1
Else
Archivmonat = Monat - 2
Archivjahr = Year(Now)
End If
Archivname = "Stand_" & Archivmonat & "_" & Archivjahr & ".xls"
FileCopy "c:\excel\aktuell.xls", "c:\excel\Aktuell_alt.xls"
AlterName = "c:\excel\Vormonat.xls": Neuername = "c:\Excel\" & Archivname
Name AlterName As Neuername
AlterName = "c:\Excel\Aktuell_alt.xls": Neuername = "c:\Excel\Vormonat.xls"
Name AlterName As Neuername
Workbooks.Open Filename:=Datei
For Each Book In Workbooks
For Each Sh In Book.Sheets
For Each Button In Sh.Shapes
If Button.Type = msoAutoShape Then
If Button.DrawingObject.Caption = "Vormonat" Then
Button.DrawingObject.Caption = "Aktuell"
Sh.Hyperlinks.Add Button, "C:\Neu.xls"
End If
End If
Next Button
Next Sh
Next Book
Workbooks("c:\excel\vormonat.xls").Close SaveChanges:=True
Exit Sub
Meldung:
titel1 = "Fehler"
Mel0 = "Sie haben die Datei bereits einmal gesichert."
antwort = MsgBox(Mel0 + Chr(13), vbOKOnly, titel1)
End Sub

For Each Book In Workbooks For Each Sh In Book.Sheets For Each Button In Sh.Shapes If Button.Type = msoAutoShape Then If Button.DrawingObject.Caption = "Vormonat" Then Button.DrawingObject.Caption = "Aktuell" Sh.Hyperlinks.Add Button, "C:\Neu.xls" End If End If Next Button Next Sh Next Book

On Error Resume Next For Each Book In Workbooks For Each Sh In Book.Sheets For Each Button In Sh.Shapes If Button.Type = msoAutoShape Then If Button.DrawingObject.Caption = "Vormonat" Then If Err.Number = 0 Then Button.DrawingObject.Caption = "Aktuell" Sh.Hyperlinks.Add Button, "C:\Neu.xls" Else Err.Clear End If End If End If Next Button Next Sh Next Book

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread