A1VBCode Forums

Problem with Hyperlinks.Add


http://www.a1vbcode.com/vbforums/Topic27652.aspx

By ferasferas - 5/9/2009

 Derar evetybody
 
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 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

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