Telefonnummer zu ausgewähltem Kontakt automatisch auslesen und in Liste ergänzen

..ich habe mir so geholfen:

1. In den Kontakten nach "Kategorie" sortiert
2. Alle Kontakte der gewünschten Kategorie ausgewählt (markiert)
3. im Menü rechts neben "löschen" auf "E-Mail" geklickt und schwups hatte ich sie in einer neuen Adresse
   

Viel Erfolg..

Yogi

Hallo Ulrike,

Danke für deine Nachricht in unserem Support-Forum.

Ich bräuchte, um dir besser helfen zu können, noch ein paar Informationen:

1. Wo möchtest du deine Telefonnummer hinzufügen?

2. Bekommst du eine Fehlermeldung? Wenn ja, könntest du ein Screenshot schicken?

Ich freue mich auf deine Antwort.

Grüße,

Federica

Hallo, ich wollte in meinem officeaccount meine persönlichen Daten ergänzen. Es wird automatisch Österreich mit der Länderkennzahl vorgeschlagen. Die Fehlermeldung ist nur, dass das keine gültige Telefonnummer sei und irgendwelche Sonderzeichen erlaubt seien.
Egal wie ich die nummer eingebe mit 0 ohne sie wird abgelehnt

... Das Problem ist nur, dass man bei Skype keine mailadresse ergänzen kann, wenn diese nicht vom Kontakt selber erstellt wurde. (oder doch?)

Hallo Volker,

ich habe den Code etwas verändert, d.h. genauer referenziert. Dann läuft der Code von jedem Blatt aus. Du musst nur für wsh1 den richtigen Tabellennamen einsetzen.

Sub KommentareAuflisten()

   'David McRitchie, misc,  2002-08-09, corrected 2002-08-10

   'reference:  http://www.mvps.org/dmcritchie/excel/ccomments.htm

   

   Dim rngC As Range

   Dim i As Long

   Dim RowOS As Long

   Dim wsNew As Worksheet, wsh1 As Worksheet

   

   Application.DisplayAlerts = False

   On Error Resume Next

   Sheets("Kommentare").Delete

   Application.DisplayAlerts = True

   Application.Calculation = xlCalculationManual

   

   Set wsh1 = Sheets("Tabelle1")

   If wsh1.Comments.Count = 0 Then

     MsgBox "Keine Kommentare vorhanden!"

     Exit Sub

   End If

   

   Application.ScreenUpdating = False

   

'   Set wsSource = ActiveSheet

   Sheets.Add

   ActiveSheet.Name = "Kommentare"

   Set wsNew = Sheets("Kommentare")

   

'   wsSource.Activate

   With wsNew

    .Columns("A").ColumnWidth = 12

    .Columns("B").ColumnWidth = 12

    .Columns("C").ColumnWidth = 20

    .Columns("D").ColumnWidth = 20

    .Columns("E").ColumnWidth = 17

    With .Columns("A:E")

       .VerticalAlignment = xlTop

       .WrapText = True

    End With

   End With

   

   

   wsNew.PageSetup.PrintGridlines = True

   RowOS = 2

   

  wsNew.Cells(1, 1) = "'" & Application.ActiveWorkbook.Name & " -- " & _

       Application.ActiveSheet.Name

  wsNew.Cells(2, 1) = "ZellAdresse"

  wsNew.Cells(2, 2) = "Autor"

  wsNew.Cells(2, 3) = "Zellinhalt"

  wsNew.Cells(2, 4) = "Kommentar"

  wsNew.Cells(2, 5) = "ZellinhaltSpalteA"

   

   For Each rngC In wsh1.UsedRange

        If Not rngC.Comment Is Nothing Then

            If Len(rngC.Comment.Text) > 0 Then

                RowOS = RowOS + 1

                wsNew.Cells(RowOS, 1) = rngC.Address(0, 0)

                wsNew.Cells(RowOS, 2) = rngC.Comment.Author

                wsNew.Cells(RowOS, 3) = rngC.Text

                wsNew.Cells(RowOS, 4) = Replace(Replace(rngC.Comment.Text, _

                    rngC.Comment.Author, ""), ":" & Chr(10), "")

                wsNew.Cells(RowOS, 5) = wsh1.Cells(rngC.Row, 1).Value

            End If

        End If

    Next   

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

Claus

Hallo Claus,

vielen Dank für die schnelle und kompetente Antwort. Das Ergebnis entspricht voll meinen Erwartungen.

Ich werde mich sicherlich nochmals melden müssen, wenn es um das Zurückschreiben der editierten Kommentartexte geht.

Volker