Most people don't have the same degree of trust in Microsoft's ability to offer perfect suggestions as you do. This macro would do what you asked for...
Code:
Sub MrFixit()
Dim iErr As Integer, i As Integer, aRng As Range
iErr = ActiveDocument.Range.SpellingErrors.Count
For i = iErr To 1 Step -1
Set aRng = ActiveDocument.Range.SpellingErrors(i)
If aRng.GetSpellingSuggestions.Count = 1 Then
aRng.Text = aRng.GetSpellingSuggestions.Item(1).Name
End If
Next i
End Sub