AW: Zusammenfassung zu allen Beiträgen
13.03.2014 22:27:42
Jenny
Hallo Karin,
sorry, das hätte der Code sein sollen
Sub BilderRaus()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Delete
Next sh
End Sub
Sub Makro1()
' Makro1 Makro
' Tastenkombination: Strg+i
Dim lngLetzte As Long
Dim lngLetzte2 As Long
Application.Run "Mappe1!Tabelle1.BilderRaus"
With ActiveWorkbook.Worksheets("Tabelle1")
.Range("A:A,C:D").Delete Shift:=xlToLeft
With .Columns("A:A")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.EntireColumn.AutoFit
.MergeCells = False
End With
lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
lngLetzte2 = Worksheets("Tabelle4").Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
.Range(.Cells(1, 1), .Cells(lngLetzte, 1)).Copy Worksheets("Tabelle4").Cells( _
lngLetzte2 + _
1, 1)
End With
With ActiveWorkbook.Worksheets("Tabelle4")
lngLetzte2 = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
.Range(.Cells(1, 1), .Cells(lngLetzte2, 1)).Sort Key1:=.Range("A1"), Order1:= _
xlAscending, _
_
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Application.Run "Mappe1!Tabelle1.HyperlinkAdressaenderung"
End Sub
Sub HyperlinkAdressaenderung()
Dim rngZelle As Range
For Each rngZelle In Columns(1).SpecialCells(xlCellTypeConstants)
If rngZelle.Hyperlinks.Count > 0 Then
rngZelle.Hyperlinks(1).Address = _
Application.Substitute(rngZelle.Hyperlinks(1).Address, _
"http://www", "https://pro-labs")
End If
Next rngZelle
End Sub