The tricky part is shown in the following code. It saves the current picture into an ImageList control and then uses that control's ExtractIcon method to pull the image back out as an icon image.

Private Sub mnuSave_Click()
    ComDia.CancelError = True
    On Error GoTo exitIt
    ComDia.FileName = ""
    ComDia.flags = cdlOFNOverwritePrompt + _
        cdlOFNNoReadOnlyReturn
    ComDia.Filter = "Icons (*.ico)|*.ico|Bitmaps " & _
        "(*.bmp)|*.bmp"
    ComDia.ShowSave
    If ComDia.FilterIndex = 1 Then
        MousePointer = 11
        Dim imgX As ListImage
        Set imgX = ImageList1.ListImages. _
        Add(1, , picReal.Image)
        Dim picX As Picture
        Set picX = ImageList1.ListImages(1).ExtractIcon
        SavePicture picX, ComDia.FileName
        lblPath.Caption = ComDia.FileName
        MousePointer = 0
    End If
    If ComDia.FilterIndex = 2 Then
        SavePicture picReal.Image, ComDia.FileName
        lblPath.Caption = ComDia.FileName
    End If
    Dirty = False
    Exit Sub
exitIt:
End Sub