ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,226
- Office Version
- 2007
- Platform
- Windows
Morning,
I am using the supplied code on my userform which works fine but need to ask for some advice if i may.
Im having an issue now & then with the format of my worksheet so ive decided that i need to apply fonts / size etc etc when the data from the userform is sent to the worksheet.
I wish to add properties like example below but i dont need the Range A1 i need it applied for the row its going to be sent to from the userform,
I can apply the font,size,bold,horizontal alignment etc etc but can you advise where i also need to place it in my code
Range("A1").Font.Color = vbRed
Range("A1").Font.Bold = True
Many Thanks
I am using the supplied code on my userform which works fine but need to ask for some advice if i may.
Im having an issue now & then with the format of my worksheet so ive decided that i need to apply fonts / size etc etc when the data from the userform is sent to the worksheet.
I wish to add properties like example below but i dont need the Range A1 i need it applied for the row its going to be sent to from the userform,
I can apply the font,size,bold,horizontal alignment etc etc but can you advise where i also need to place it in my code
Range("A1").Font.Color = vbRed
Range("A1").Font.Bold = True
Many Thanks
VBA 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.Visible = True And TextBox4.Text = "" Then
Cancel = 1
MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
TextBox4.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"
ElseIf OptionButton12.Value = False And OptionButton13.Value = False Then
Cancel = 1
MsgBox "YOU MUST SELECT A USER NAME OPTION", 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, 4).Value = TextBox6.Text
.Cells(LastRow + 1, 9).Value = TextBox9.Text
.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, 7).Value = "COLLECTION"
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
If OptionButton12.Value = True Then .Cells(LastRow + 1, 9).Value = "N/A": OptionButton12.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 SECURITY MARK MESSAGE") = vbYes Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox6.Value = ""
TextBox9.Value = ""
.Cells(LastRow + 1, 11).Value = "YES"
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")
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox6.Value = ""
TextBox9.Value = ""
TextBox2.SetFocus
NameForDateEntryBox.Clear
UserForm_Initialize
End Sub