promlem with HyperLink

[FirasSHhady]

Dera
here is my code which copy an existting sheet and make a hyperlink to it in the main sheet with friendly name.
but when press the button of that form i always have a error messeage, and the compiler stope at the hyperlink line code.

the message tell am that the add mwthode for hyperlink is faild.

anyhelp

Private Sub cmdOKNewCust_Click()
Dim strCustName As String
Dim FirstPeriodSum As Double
Dim wsh As Worksheet


Dim strReceipt As String, strGPhone As String, strMobile As String, strFax As String, strAddress As String

'check ComboBox
    If txtCustName <> "" Then
        strCustName = txtCustName
    Else
        MsgBox "No Entry??"
        txtCustName.SetFocus
        Exit Sub
    End If

'
    If txtCustFirstPeriod = "" Then
        FirstPeriodSum = 0
    Else
        FirstPeriodSum = txtCustFirstPeriod
    End If
strReceipt = txtReceiptNum
strGPhone = txtCustGPhone
strMobile = txtCustMobile
strFax = txtCustFax
strAddress = txtCustAddress

'
Application.ScreenUpdating = False

'copy one sheet
Sheets("Cust").Copy After:=Sheets("Customers")

'ÇÓã æÑÞÉ ÇáÒÈæä
Cust_Sheet_Name = "Cu" & Application.Sheets.Count + 1

'No duplicate name
For Y = 1 To ActiveWorkbook.Sheets.Count
    If Cust_Sheet_Name = ActiveWorkbook.Sheets(Y).Name Then
        Cust_Sheet_Name = "Ò" & Application.Sheets.Count + Int(Rnd() * 10)
        Y = 1
    End If
Next

'ÊÛííÑ ÇÓã ÇáæÑÞÉ
Set wsh = ActiveSheet
wsh.Name = Cust_Sheet_Name


'ÇÏÎÇá ÇÓã ÇáÒÈæä ÇáÌÏíÏ Ýí ÇáÎáíÉ ÇáÎÇÕÉ ÈÇáÇÓã
wsh.Range("A5") = "ÍÓÇÈ ÇáÓíÏ " & Trim(strCustName)
wsh.Range("B11").Value = FirstPeriodSum
wsh.Range("D11").Value = strReceipt
wsh.Range("E11").Value = "ÑÕíÏ ÓÇÈÞ"
wsh.Range("F11").Value = Format(Now(), "m/d/yyyy")

'ÊÓØíÑ ÊÍÊ ÑÕíÏ Ãæá ÇáãÏÉ
wsh.Range("b11:f11").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With

'_____ÇáÐåÇÈ Åáì æÑÞÉ ÇáÒÈÇÆä_____
Sheets("Customers").Activate
Set wsh = ActiveSheet

   If wsh.Range("B10").Value = "" Then
        wsh.Range("B10").Select
    ElseIf wsh.Range("B11") = "" Then
        wsh.Range("B11").Select
    Else
        wsh.Range("B10").End(xlDown).Offset(1, 0).Select
    End If
Dim i As Integer 'ÓØÑ ÇáÎáíÉ ÇáÊí ÊÍæí Úáì ÃÓã ÇáÒÈæä
i = Selection.Row
wsh.Range("B" & i).Select
'Dim rg As Range
Dim sbAdd As String
Dim scTip As String
Dim txToDsply As String
'
'Set rg = wsh.Range("B" & i)
sbAdd = Cust_Sheet_Name & "!A5"
scTip = "Åáì ÕÝÍÉ ÇáÒÈæä " & strCustName
txToDsply = strCustName

[b]
[COLOR=red]
'Here is the problem 
wsh.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=sbAdd, ScreenTip:=scTip, TextToDisplay:=txToDsply
[/color]
[/b]
With Selection.Font
    .Name = Arial
    .Size = 13
    .Bold = True
    .Underline = False
End With

'áÕÞ ÑÕíÏ ÇáÒÈæä Ýí ÇáÎáíÉ ÇáãÌÇæÑÉ áÃÓãå áÕÞ ÇÑÊÈÇØ
Sheets("ÇáÒÈÇÆä").Activate
Set wsh = ActiveSheet
wsh.Range("C" & i).Select
ActiveCell.Formula = "=" & Cust_Sheet_Name & "!$C$5"

'ÊäÓíÞ ÇáÑÕíÏ ÇáãÑÍá
With Selection.Font
    .Name = Arial
    .Size = 13
    .Bold = True
    .Underline = False
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0_-;_-* #,##0-;_-* ""-""??_-;_-@_-"
End With

'ÅÚÇÏÉ ÝÑÒ ÃÓãÇÁ áÒÈÇÆä
Call Cust_Names_Sort

'ÅÚÇÏÉ ãáìÁÇáÃÑÞÇã ÇáÊÓáÓáíÉ
If wsh.Range("B10") = "" Then
    Cust_Number = 0
    ElseIf (wsh.Range("B10") <> "") And (wsh.Range("B11") = "") Then
        Cust_Number = 1
    Else
    wsh.Range(("B10"), wsh.Range("B10").End(xlDown)).Select
    Cust_Number = Selection.Rows.Count
End If
wsh.Range("A10").Select
i = 10 'ÑÞã ÇáÓØÑ ÇáÐí íÈÏà ÚäÏå ÊÑÞíã ÊÓáÓá ÇáÒÈÇÆä
For j = 1 To Cust_Number
    wsh.Range("A" & i).Value = j
    i = i + 1
Next j

'_________ æÑÞÉ ÇáÏáíá ________
'##ÅÖÇÝÉ ÃÓã ÇáÒÈæä áÏáíá
Sheets("Ïáíá").Activate
Set wsh = ActiveSheet
  If wsh.Range("B10") = "" Then
        wsh.Range("B10").Select
        ElseIf wsh.Range("B11") = "" Then
            wsh.Range("B11").Select
        Else
        wsh.Range("B10").End(xlDown).Offset(1, 0).Select
    End If
i = Selection.Row 'ãÚÑÝÉ ÓØÑ ÇáÎáíÉ
Selection.Value = strCustName
wsh.Range("A" & i).Value = "Ò"
wsh.Range("C" & i) = strGPhone
wsh.Range("D" & i) = strMobile
wsh.Range("E" & i) = strFax
wsh.Range("F" & i) = strAddress

'###ÅÚÇÏÉ ÝÑÒ æÑÞÉ Ïáíá ÇáÇÊÕÇáÇÊ
Call Sort_Phone
'
Application.ScreenUpdating = True

Unload frmNewCust
Sheets(Cust_Sheet_Name).Activate
MsgBox "Êã ÅÖÇÝÉ ÇáÒÈæä: " & vbCrLf & "ÇáÇÓã: " & strCustName & vbCrLf & "ÈäÌÇÍ", , "ÅÖÇÝÉ ÒÈæä ÌÏíÏ"

'ÊÝÑíÛ ÇáãÑÈÚÇÊ
txtCustName = ""
txtCustFirstPeriod = ""
txtReceiptNum = ""
txtCustGPhone = ""
txtCustMobile = ""
txtCustFax = ""
txtCustAddress = ""

End Sub

I'm using MS Excel 2007
and the unreadding text here that becouse of copy past and it's just string ""

 

[FirasSHhady]

here is the code again but with refine
hope to get some help

Private Sub cmdOKNewCust_Click() 
    Dim strCustName As String 
    Dim FirstPeriodSum As Double 
    Dim sbAdd As String 
    Dim scTip As String 
    Dim txToDsply As String 
    Dim Cust_Sheet_Name As String 
    Dim Cust_Number As Integer 
    Dim j As Integer 
    Dim i As Integer 
    Dim strReceipt As String, strGPhone As String, strMobile As String, strFax As String, strAddress As String 
     'Cust Name Check
    If txtCustName <> "" Then 
        strCustName = txtCustName 
    Else 
        MsgBox "No name", vbOKOnly, "try again" 
        txtCustName.SetFocus 
        Exit Sub 
    End If 
     
     'Fist Account
    If txtCustFirstPeriod = "" Then 
        FirstPeriodSum = 0 
    Else 
        FirstPeriodSum = txtCustFirstPeriod 
    End If 
    strReceipt = txtReceiptNum 
    strGPhone = txtCustGPhone 
    strMobile = txtCustMobile 
    strFax = txtCustFax 
    strAddress = txtCustAddress 
     '
    Application.ScreenUpdating = False 
     
     'Copy Cust Sheet
    Sheets("Cust").Copy After:=Sheets("Customers") 
     'change new sheet name
    Cust_Sheet_Name = "c" & Application.Sheets.Count + 1 
     
     'check new sheet name
    For j = 1 To ActiveWorkbook.Sheets.Count 
        If Cust_Sheet_Name = ActiveWorkbook.Sheets(j).Name Then 
            Cust_Sheet_Name = "c" & Application.Sheets.Count + Int(Rnd() * 10) 
            j = 1 
        End If 
    Next 
     'change sheet name
    ActiveSheet.Name = Cust_Sheet_Name 
     'fill some field
    ActiveSheet.Range("A5") = "Mr." & Trim(strCustName) 
    ActiveSheet.Range("B11").Value = FirstPeriodSum 
    ActiveSheet.Range("D11").Value = strReceipt 
    ActiveSheet.Range("E11").Value = "Bill" 
    ActiveSheet.Range("F11").Value = Format(Now(), "dd/mm/yyyy") 
     'First account border
    ActiveSheet.Range("b11:f11").Select 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .Weight = xlMedium 
        .ColorIndex = xlAutomatic 
    End With 
     
     '_____Customers Sheet_____
    Sheets("Customers").Activate 
    If Not IsNull(Sheets("Customers").Range("B500").End(xlUp)) Then 
        i = Sheets("Customers").Range("B500").End(xlUp).Offset(1, 0).Row 
    Else 
        i = Sheets("Customers").Range("B500").End(xlUp).Row 
    End If 
     '
    sbAdd = Cust_Sheet_Name & "!A5" 
    scTip = "Go to Ctstomer " & strCustName 
    txToDsply = strCustName 
     
     'the hyperlink
    With Application.Sheets("Customers") 
    .Hyperlinks.Add Anchor:=.Range("B" & i), Address:="", SubAddress:=sbAdd, ScreenTip:=scTip, TextToDisplay:=txToDsply 
    End With 
     
     
     'Cust Account past
    Sheets("Customers").Activate 
    ActiveSheet.Range("C" & i).Select 
    ActiveCell.Formula = "=" & Cust_Sheet_Name & "!$C$5" 
     'format the account
    With Selection.Font 
         '.Name = Arial
        .Size = 13 
        .Bold = True 
        .Underline = False 
        Selection.Style = "Comma" 
        Selection.NumberFormat = "_-* #,##0_-;_-* #,##0-;_-* ""-""??_-;_-@_-" 
    End With 
     
     'resotr customers sheet
    Call Cust_Names_Sort 
     
     'reFill the serial num
    Cust_Number = Sheets("Customers").Range("Customers_List").Count 
    i = 10 
    For j = 1 To Cust_Number 
        ActiveSheet.Range("A" & i).Value = j 
        i = i + 1 
    Next j 
     
     '_________ AlDaleel Sheet ________
    Sheets("Daleel").Activate 
    If Not IsNull(Sheets("Daleel").Range("B1000").End(xlUp)) Then 
        i = Sheets("Daleel").Range("B1000").End(xlUp).Offset(1, 0).Row 
    Else 
        i = Sheets("Daleel").Range("B10500").End(xlUp).Row 
    End If 
    ActiveSheet.Range("A" & i).Value = "Ò" 
    ActiveSheet.Range("B" & i).Value = strCustName 
    ActiveSheet.Range("C" & i) = strGPhone 
    ActiveSheet.Range("D" & i) = strMobile 
    ActiveSheet.Range("E" & i) = strFax 
    ActiveSheet.Range("F" & i) = strAddress 
     'Resort al-daleel
    Call Sort_Phone 
     '
    Application.ScreenUpdating = True 
    Unload frmNewCust 
    Sheets(Cust_Sheet_Name).Activate 
    MsgBox "Add: " & vbCrLf & "Cust: " & strCustName & vbCrLf & "Successfuly", , "message" 
     'empty frmNewCust fields
    txtCustName = "" 
    txtCustFirstPeriod = "" 
    txtReceiptNum = "" 
    txtCustGPhone = "" 
    txtCustMobile = "" 
    txtCustFax = "" 
    txtCustAddress = "" 
End Sub

 

[SkipVought]

Exactly what is the error message?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[FirasSHhady]

the massage is:
run-time error -2147417848 (80010108)
the object invoked has disconnected from it's client

any ideas