ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,226
- Office Version
- 2007
- Platform
- Windows
Hi,
Supplied is the working code in use.
The item in red in my code gets to the point of the msgbox WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?
If you select NO in continues & does what its supposed to soall is ok there.
BUT
If you select YES you are taken to the folder no problem BUT when you close the folder down then the code has continued to add the values to the worksheer & also clearing the userform.
Can you advise please what i should do so if YES is selected the code doesnt contine so i can then open the folder,do what i need to do then once the folder is closed i still have the userform with values in from of me.
Thanks
Supplied is the working code in use.
The item in red in my code gets to the point of the msgbox WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?
If you select NO in continues & does what its supposed to soall is ok there.
BUT
If you select YES you are taken to the folder no problem BUT when you close the folder down then the code has continued to add the values to the worksheer & also clearing the userform.
Can you advise please what i should do so if YES is selected the code doesnt contine so i can then open the folder,do what i need to do then once the folder is closed i still have the userform with values in from of me.
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.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"
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
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
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
[COLOR=rgb(184, 49, 47)] If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbNewLine & "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then[/COLOR]
CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
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