ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,738
- Office Version
- 2007
- Platform
- Windows
Morning,
I am using the code supplied below.
After i complete the values on the userform i then send them to my worksheet.
The issue in question is that when the hyperlink is applied to the cell in column B its font size is always 16 where all the other fonts on the worksheet are 12
So i would like at the time of sending the values to the worksheet for the hyperlink to be 12 NOT 16
Shown in red below i think this is where the code needs to be applied but not sure how to go about it in respect of making the cell in column B
I am using the code supplied below.
After i complete the values on the userform i then send them to my worksheet.
The issue in question is that when the hyperlink is applied to the cell in column B its font size is always 16 where all the other fonts on the worksheet are 12
So i would like at the time of sending the values to the worksheet for the hyperlink to be 12 NOT 16
Shown in red below i think this is where the code needs to be applied but not sure how to go about it in respect of making the cell in column B
Code:
Private Sub PostageSheetTransferButton_Click()
Cancel = 0
If TextBox2.Text = "" Then
Cancel = 1
MsgBox "Customer`s Name Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
TextBox2.SetFocus
ElseIf TextBox3.Text = "" Then
Cancel = 1
MsgBox "Item Description Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
TextBox3.SetFocus
ElseIf TextBox4.Text = "" Then
Cancel = 1
MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
TextBox4.SetFocus
ElseIf ComboBox1.Text = "" Then
Cancel = 1
MsgBox "Username Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
ComboBox1.SetFocus
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
Cancel = 1
MsgBox "You Must Select An Ebay Account", vbCritical, "POSTAGE TRANSFER SHEET"
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
Cancel = 1
MsgBox "You Must Select An Origin", vbCritical, "POSTAGE TRANSFER SHEET"
ElseIf OptionButton7.Value = False And OptionButton8.Value = False And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
Cancel = 1
MsgBox "You Must Select An Postal Company", vbCritical, "POSTAGE TRANSFER SHEET"
End If
If Cancel = 1 Then
Exit Sub
End If
Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim LastRow As Long
LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
With ThisWorkbook.Worksheets("POSTAGE")
.Cells(LastRow + 1, 1).Value = TextBox1.Text
.Cells(LastRow + 1, 2).Value = TextBox2.Text
.Cells(LastRow + 1, 3).Value = TextBox3.Text
.Cells(LastRow + 1, 5).Value = TextBox4.Text
.Cells(LastRow + 1, 9).Value = ComboBox1.Text
.Cells(LastRow + 1, 4).Value = TextBox6.Text
.Cells(LastRow + 1, 7).Interior.Color = RGB(255, 0, 0)
.Cells(LastRow + 1, 7).Value = "POSTED"
If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = False
If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = False
If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = False
If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = False
If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = False
If OptionButton7.Value = True Then .Cells(LastRow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = False
If OptionButton8.Value = True Then .Cells(LastRow + 1, 10).Value = "DHL": OptionButton8.Value = False
If OptionButton9.Value = True Then .Cells(LastRow + 1, 10).Value = "MY HERMES": OptionButton9.Value = False
If OptionButton10.Value = True Then .Cells(LastRow + 1, 10).Value = "COLLECTION": OptionButton10.Value = False
If OptionButton11.Value = True Then .Cells(LastRow + 1, 10).Value = "N/A": OptionButton11.Value = False
Dim colorHTML As String, r As String, g As String, b As String
If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK LIPSTICK SECURITY MESSAGE") = vbYes Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox6.Value = ""
ComboBox1.Value = ""
colorHTML = "FF0099"
r = WorksheetFunction.Hex2Dec(Left(colorHTML, 2))
g = WorksheetFunction.Hex2Dec(Mid(colorHTML, 3, 2))
b = WorksheetFunction.Hex2Dec(Right(colorHTML, 2))
.Cells(LastRow + 1, 4).Interior.Color = RGB(r, g, b)
End If
MsgBox "CUSTOMER POSTAGE SHEET HAS NOW BEEN UPDATED", vbInformation, "SUCCESSFUL UPDATE MESSAGE"
Application.Goto Sheets("POSTAGE").Range("B" & Rows.Count).End(xlUp), True
err:
Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
If ActiveCell.Column = Columns("B").Column Then
If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".jpg"
MsgBox "CUSTOMER PHOTO HYPERLINK WAS SUCCESSFUL.", vbInformation, "POSTAGE SHEET HYPERLINK MESSAGE"
End If
Else
MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "POSTAGE SHEET HYPERLINK MESSAGE"
Exit Sub
End If
If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
"WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?" & vbCrLf & vbCrLf & _
"YES = OPEN THE PHOTO FOLDER" & vbCrLf & vbCrLf & _
"NO = HYPERLINK IS NOT REQUIRED", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then
CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
MsgBox "CONTINUE TO NOW HYPERLINK CUSTOMER & PHOTO ?", vbInformation, "HYPERLINK PHOTO MESSAGE"
GoTo err
End If
End If
End With
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
Unload PostageTransferSheet
PostageTransferSheet.Show
End Sub