Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hyperlink entfernen und Zelle einfärben / Wert ?

Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 15:13:04
Selma
Hallo Leute,
was muss ich in unten stehendem Makro anpassen, damit nicht nur der Hyperlink in Spalte C entfernt wird, sondern auch der Wert der nach dem Entfernung des Hyperlinks stehen bleibt ?

Sub Hyperlink_Makro()
'Wenn in Spalte C die Zelle die Füllfarbe 22 und ein Hyperlink hat dann wird der Hyperlink  _
dieser Zelle entfernt.
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
If h.Range.Column = 3 Then
If h.Range.Interior.ColorIndex = 22 Then
h.Range.Select
h.Delete
With Selection.Font
.Name = "Lucida Sans"
.Italic = False
.Bold = True
.Size = 15
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
End If
End If
Next
End Sub


Besten Dank !
Viele Grüße,
Selma

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 15:23:02
D.Saster
Hallo,

Sub Hyperlink_Makro()
'Wenn in Spalte C die Zelle die Füllfarbe 22 und ein Hyperlink hat dann wird der Hyperlink _
dieser Zelle entfernt.
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
If h.Range.Column = 3 Then
If h.Range.Interior.ColorIndex = 22 Then
With h.Range
With .Font
.Name = "Lucida Sans"
.Italic = False
.Bold = True
.Size = 15
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
.ClearContents
End With
h.Delete
End If
End If
Next
End Sub


Gruß
Dierk

Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 15:34:16
Selma
Hallo Dierk,
hier "h.Delete" (Run-time error 424) bleibt der Code stehen.
VG,
Selma
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 15:55:23
D.Saster
Hallo,
vllt. so:

If h.Range.Interior.ColorIndex = 22 Then
h.Delete
With h.Range
With .Font
.Name = "Lucida Sans"
.Italic = False


Gruß
Dierk

AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 16:04:09
Selma
jetzt bleibt es hier "With h.Range" stehen
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 22:26:47
Josef
Hallo Selma,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Hyperlink_Makro()
  'Wenn in Spalte C die Zelle die Füllfarbe 22 und ein Hyperlink hat dann wird der Hyperlink _
    dieser Zelle entfernt.

  
  Dim h As Hyperlink
  
  For Each h In ActiveSheet.Hyperlinks
    If h.Parent.Column = 3 Then
      If h.Parent.Interior.ColorIndex = 22 Then
        '----------------------
        With h.Parent
          With .Font
            .Name = "Lucida Sans"
            .Italic = False
            .Bold = True
            .Size = 15
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
          End With
          
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlNone
          
          With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Interior
            .ColorIndex = 16
            .Pattern = xlSolid
          End With
          .Value = ""
        End With
        '----------------------
      End If
    End If
  Next
End Sub

Gruß Sepp

Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
07.05.2009 22:45:46
Selma
Hallo Sepp,
es funktioniert wie immer....
Besten Dank !!!
Liebe Grüße,
Selma
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
08.05.2009 09:46:27
Selma
Hallo Sepp,
noch eine Ergänzung:
Wenn in Spalte C die Zelle die Füllfarbe 15, ein Hyperlink und die Zelle rechts daneben die Füllfarbe 6 hat dann soll der Hyperlink dieser Zelle entfernt werden.
Was muss ich ändern?
Besten Dank !
Liebe Grüße,
Selma
Ergänzung: Hyperlink entfernen
09.05.2009 02:05:25
Luc:-?
Moin-Moin, Selma;
unter If h.Parent.Column = 3 Then musst du noch eine If-Abfrage unterbringen...

If h.Parent.Interior.ColorIndex = 15 And h.Parent.Offset(0, 1).Interior.ColorIndex = 6 Then _
h.Parent.Clear

...oder so ähnlich...
Gruß Luc :-?

Anzeige
AW: Ergänzung: Hyperlink entfernen
09.05.2009 19:27:49
Selma
Hallo Luc :-?,
bie mir funktioniert es nicht...
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit

Sub Hyperlink_Makro()
'Wenn in Spalte C die Zelle die Füllfarbe 15, ein Hyperlink und die Zelle rechts daneben die Fü _
llfarbe 6 hat dann soll der Hyperlink dieser Zelle entfernt werden.
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
If h.Parent.Column = 3 Then
If h.Parent.Interior.ColorIndex = 15 And h.Parent.Offset(0, 1).Interior.ColorIndex = 6  _
Then _
h.Parent.Clear
With h.Parent
With .Font
.Name = "Lucida Sans"
.Italic = False
.Bold = True
.Size = 15
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Value = ""
End With
End If
End If
Next
End Sub


Habe ich das richtig eingefügt?
Viele Grüße,
Selma

Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
09.05.2009 21:14:38
Josef
Hallo Selema,
meinst du so.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Hyperlink_Makro()
  'Wenn in Spalte C die Zelle die Füllfarbe 22 und ein Hyperlink hat dann wird der Hyperlink _
    dieser Zelle entfernt.

  
  Dim h As Hyperlink
  
  For Each h In ActiveSheet.Hyperlinks
    If h.Parent.Column = 3 Then
      If h.Parent.Interior.ColorIndex = 22 Then
        '----------------------
        With h.Parent
          With .Font
            .Name = "Lucida Sans"
            .Italic = False
            .Bold = True
            .Size = 15
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
          End With
          
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlNone
          
          With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Interior
            .ColorIndex = 16
            .Pattern = xlSolid
          End With
          .Value = ""
        End With
        '----------------------
      ElseIf h.Parent.Interior.ColorIndex = 15 And h.Parent.Offset(0, 1).Interior.ColorIndex = 6 Then
        h.Parent.Clear 'Alles löschen
        'oder
        'h.Delete
      End If
    End If
  Next
End Sub

Gruß Sepp

Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
09.05.2009 22:51:07
Selma
Hallo lieber Sepp,
ich habe bei meiner Fragestellung die Fehler gemacht. :-))
Anbei eine Beispieldatei (Arbeitsblätter: VORHER / NACHHER) mit kurze Beschreibung. In der Datei ist genau zu sehen, was ich erreichen möchte.
https://www.herber.de/bbs/user/61710.xls
Besten Dank !
Viele Grüße,
Selma
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
09.05.2009 23:14:46
Josef
Hallo Selma,
meinst du so?
' **********************************************************************
' Modul: Module1 Typ: Allgemeines Modul
' **********************************************************************

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Hyperlink_Makro()
  Dim rng As Range, lngLas As Long, lngRow As Long
  
  For Each rng In ActiveSheet.Columns(3).SpecialCells(xlCellTypeConstants)
    If rng.Hyperlinks.Count > 0 Then
      If rng.Interior.ColorIndex = 22 And rng.Offset(0, 1).Interior.ColorIndex = 6 Then
        '----------------------
        With rng
          .Hyperlinks.Delete
          With .Font
            .Name = "Lucida Sans"
            .Italic = False
            .Bold = True
            .Size = 15
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
          End With
          
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlNone
          
          With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
          End With
          
          With .Interior
            .ColorIndex = 6
            .Pattern = xlSolid
          End With
        End With
        '----------------------
      End If
    End If
  Next
  
  Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
09.05.2009 23:53:49
Selma
Hallo Sepp,
heute ist definitiv nicht mein Tag (zu viele Fehler) ;-)
Nach Entfernung von Hyperlink soll auch der Text entfernt werden.
richtig:
Sorry !
Viele Grüße,
Selma
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
10.05.2009 08:32:19
Josef
Hallo Selma,
dann schreib einfach nach .Hyperlinks.Delete noch .Value = ""
Gruß Sepp

AW: Hyperlink entfernen und Zelle einfärben / Wert ?
10.05.2009 10:42:23
Selma
Guten Morgen Sepp,
ich habe es getestet und es passt noch nicht ganz.
Anbei nochmal die Datei https://www.herber.de/bbs/user/61711.xls
Zum besseren Verständnis habe ich im Arbeitsblatt "NACHHER" die Beschreibung nochmal überarbeitet.
Im Arbeitsballt "ERGEBNISS NACH MAKROSTART" habe ich ebenfalls beschrieben, was nicht richtig ist.
Viele liebe Grüße,
Selma
Anzeige
AW: Hyperlink entfernen und Zelle einfärben / Wert ?
10.05.2009 22:05:57
Josef
Hallo Selma,
eigenartig, bei deiner Tabelle ist das wirklich so, wenn ich die Hyperlinks allerdings ändere,
dann ist das Ergebnis wie gewünscht.
Im Moment hab ich dafür keine Lösung.
Gruß Sepp

328 Forumthreads zu ähnlichen Themen


Hallo zusammen,
wie bekomme ich es hin, in eine Zelle "7 a" (7 Leerzeichen a) zu schreiben? Excel macht mir dann immer 7:00 AM daraus oder 0,29...
Danke
Anzeige

Guten Tag zusammen!
Bitte helft mir bei folgendem Problem:
In einer Userform habe ich eine ganze Reihe Textboxen, in die zum größten Teil Zahlen eingegeben werden.
Nun ist ja bekannt, dass beim Schreiben in Zellen der Inhalt der Textboxen als Text interpretiert wird. Mit der Anweisu...

Guten Tag zusammen!
Bitte helft mir bei folgendem Problem:
In einer Userform habe ich eine ganze Reihe Textboxen, in die zum größten Teil Zahlen eingegeben werden.
Nun ist ja bekannt, dass beim Schreiben in Zellen der Inhalt der Textboxen als Text interpretiert wird. Mit der Anweisu...
Anzeige

Halli Hallo,
ich bin ziemlicher Neuling in VBA. Daher würde ich euch bitten mir bei meiner Fragestellung zu helfen und zwar wie folgt: Ich möchte aus einer Tabelle aller Zellen kopieren, bis der Wert einer Zelle 0 annimmt. Diesen bestimten Bereich möchte ich in einer neuen Datei abspeichern...

hallo,
ich muß eine liste erstellen. die werte unten will ich nicht immer eingeben müssen, sondern nur dort wo ein wert stehen soll ein x machen. excel soll mir dann für jedes x den wert aus der zeile 2 der gleichen spalte eintragen. mache ich in eine zelle 2 x, dann muß der wert auch 2 mal...

Hi Leute
Ich habe hier diesen netten VBA Code geschrieben und leider wie solls auch anders sein kommt dauernd eine Fehlermeldung :)
CODE:
rowbeforeinteger = 2
Dim text As String
text = "=IF(" & epsoldcolumn & rowbeforeinteger & "=""x"";1;0)+IF(" & emailsoldco...
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige