TrueRise
05-09-2009, 11:43 PM
Dear everybody
here is my code which copy an existing 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 message, and the compiler stope at the hyperlink line code.
the message tell am that the add method for hyperlink is failed.
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 ""
here is my code which copy an existing 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 message, and the compiler stope at the hyperlink line code.
the message tell am that the add method for hyperlink is failed.
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 ""