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 ""