ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,832
- Office Version
- 2007
- Platform
- Windows
Hi,
Ive attached 2 screen shot
RTE 91 object variable or with block variable not set
It debugs to this line.
This is the full code but i dont see what is wrong.
Ive attached 2 screen shot
RTE 91 object variable or with block variable not set
It debugs to this line.
Rich (BB code):
.Shape.AutoShapeType = msoShapeRoundedRectangle
This is the full code but i dont see what is wrong.
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 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
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 TextBox6.Value = "" Then
.Cells(lastrow + 1, 4).Value = "NOTE"
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
Else
.Cells(lastrow + 1, 4).Value = TextBox6.Text
End If
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
.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, "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
If Worksheets("POSTAGE").Cells(lastrow + 1, 11).Value = "" Then MsgBox "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