ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,736
- Office Version
- 2007
- Platform
- Windows
Morning,
Code in use is supplied below.
I have a userform where i type in Text Boxes & also selct Option buttons.
Once finished i use the command button "PostageSheetTransferButton" to send the information to my worksheet.
I see the Msgbox & select OK for it to do so.
What ive seen is when i select the command button ALL the option button selections are then removed, the Textboxes still show the text fine.
Clicking OK then clears the Textboxes & all the correct data is now on the worksheet.
My question is what do i need to do so the Option button selections stay visable until OK is selected.
Basically to do the same as the text in the Text boxes.
Thanks
Code in use is supplied below.
I have a userform where i type in Text Boxes & also selct Option buttons.
Once finished i use the command button "PostageSheetTransferButton" to send the information to my worksheet.
I see the Msgbox & select OK for it to do so.
What ive seen is when i select the command button ALL the option button selections are then removed, the Textboxes still show the text fine.
Clicking OK then clears the Textboxes & all the correct data is now on the worksheet.
My question is what do i need to do so the Option button selections stay visable until OK is selected.
Basically to do the same as the text in the Text boxes.
Thanks
Rich (BB 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 And OptionButton14.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"
ElseIf OptionButton13.Value = True And TextBox9.Value = "" Then
Cancel = 1
MsgBox "YOU MUST ENTER A EBAY USER NAME", vbCritical, "POSTAGE TRANSFER SHEET"
TextBox9.SetFocus
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
Dim LArea As Long
Dim xShape As shape
Dim Mycomments As Variant
LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
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"
.Cells(LastRow + 1, 4).NoteText Text:=TextBox10.Text
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
If OptionButton14.Value = True Then .Cells(LastRow + 1, 10).Value = "DPD": OptionButton14.Value = False
On Error Resume Next
With ThisWorkbook.Worksheets("POSTAGE").Cells(LastRow + 1, 4).Comment
.shape.Autoshapetype = msoShapeRoundedRectangle
.shape.TextFrame.Characters.Font.Name = "Times Roman" ' FONT FAMILY STYLE
.shape.TextFrame.Characters.Font.Size = 12 ' TEXT SIZE
.shape.TextFrame.Characters.Font.ColorIndex = 5 ' TEXT COLOR
.shape.LINE.ForeColor.RGB = RGB(0, 0, 0) ' ARROW & LINE COLOR
.shape.Fill.Visible = msoTrue
.shape.Fill.ForeColor.RGB = RGB(255, 255, 255) ' FILL COLOR
.shape.TextFrame.AutoSize = True
End With
On Error GoTo 0
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 = ""
TextBox10.Value = ""
.Cells(LastRow + 1, 11).Value = "YES"
Application.ScreenUpdating = True
Else
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox6.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
.Cells(LastRow + 1, 11).Value = "NO"
Application.ScreenUpdating = True
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, "SUCCESSFUL HYPERLINK MESSAGE"
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 = ""
TextBox10.Value = ""
TextBox2.SetFocus
NameForDateEntryBox.Clear
UserForm_Initialize
End If
Else
MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "HYPERLINK ERROR 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 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
If Worksheets("POSTAGE").Cells(LastRow + 1, 11).Value = "" Then MsgBox "THERE ISNT A YES / NO VALUE IN SECURITY CELL", vbCritical, "SECURITY MESSAGE"
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 = ""
TextBox10.Value = ""
TextBox2.SetFocus
NameForDateEntryBox.Clear
UserForm_Initialize
End If
End With
End Sub