insert image

[freefly]

Hi,

I'm new to vba, I have a few questions:
1. how do insert an image (resize at the same time) into a column at the end of the row?
2. how do insert a row at the end of the row (not the max, but the next empty row)?
3. this is what i want to achieve, i want to open a new file if doesn't exit, if exist, open it using vba. anyone can help me to achieve this?

thanks
freefly

[mdmackillop]

Hi Freefly
Welcome to VBAX
Can you post a sample workbook to clarify what you are trying to achieve? Use Manage Attachments in the Go Advanced reply section.
Please also expand on Point 3. If what doesn't exist?

[freefly]

hi,
Thanks for the response. currently my program just create a new file every time I add a record. what i want to achieve is that the program will check whether the excel file exist or not. if the excel file with the same name exist, it should append the new record at the end of the list (the next empty row), with a picture at the end of the row. thanks for all the help.

[mdmackillop]

Where does the file name come from? Where does the data come from? Where do the pictures come from?
I think we need to see your code.

[rbrhodes]

An answer looking for a question...or 3...

[freefly]

I guess I was not very clear about what I want to achieve. Anyway I manage to do what I want to do. Here's my code:
[VBA]Private Sub ADD_Click()

Dim oExcel As Excel.Application
Dim oBook, oSheet, pic As Object
Dim i, PicLocation, MyRange, FNew As String
Dim r, l As Long
Dim DataArray(1 To 1, 1 To 16) As Variant
Dim TargetCell As Range

On Error GoTo HandleErr
Set oExcel = New Excel.Application

' check file exist or not
If Len(Dir("D:\TEXTILES\Textiles.xls")) = 0 Then
'This file does NOT exist
'Start a new workbook in Excel
FNew = "YES"
Set oBook = oExcel.Workbooks.ADD
'Add headers to the worksheet on row 1
Set oSheet = oBook.Worksheets(1)
'oSheet.Unprotect
oSheet.Range("A1:Q1").Value = Array("COUNTRY CODE", "PRODUCT CODE", "DESCRIPTION", _
"COST PRICE", "SELLING PRICE", "LENGTH", _
"COMMENTS", "HOT ITEM", "ORDER'S DATE", _
"COLOUR GIVEN DATE", "ITEM NUMBER", "FACTORY", _
"PRICE (USD)", "QUANTITY", "AMOUNT (USD)", _
"SHIPMENT", "IMAGE")
Else
'This file does exist
FNew = "NO"
Set oBook = Workbooks.Open("D:\TEXTILES\Textiles.xls")
Set oSheet = oBook.Worksheets(1)
'oSheet.Unprotect
End If

Range("Q2").Select
MyRange = Selection.Address
r = LastRow(oSheet.UsedRange)
r = r + 1

'Create an array with 16 columns and 1 rows
DataArray(1, 1) = CountryCode.Value
DataArray(1, 2) = ProductCode.Value
DataArray(1, 3) = Description.Value
DataArray(1, 4) = CostPrice.Value
DataArray(1, 5) = SellingPrice.Value
DataArray(1, 6) = CInt(Length.Value)
DataArray(1, 7) = Comments.Value
DataArray(1, 8) = HotItem.Value
DataArray(1, 9) = OrdersDate.Value
DataArray(1, 10) = ColorGivenDt.Value
DataArray(1, 11) = Item.Value
DataArray(1, 12) = Factory.Value
DataArray(1, 13) = PriceUSD.Value
DataArray(1, 14) = CInt(Quantity.Value)
DataArray(1, 15) = AmountUSD.Value
DataArray(1, 16) = Shipment.Value

'Transfer the array to the worksheet starting at the next empty row
oSheet.Range("A" & r).Resize(1, 16).Value = DataArray

'insert an image
Set TargetCell = oSheet.Cells(oSheet.Rows.Count, 17).End(xlUp).Offset(r - 1)
PicLocation = Application.GetSaveAsFilename("C:\", "Image Files (*.jpg),*.jpg", , "Specify Image Location")
Set pic = oSheet.Pictures.Insert(PicLocation)
pic.Top = TargetCell.Top
pic.Left = TargetCell.Left
pic.Width = pic.Width / 5
pic.Height = pic.Height / 5
pic.ShapeRange.PictureFormat.CropRight = 20
pic.ShapeRange.PictureFormat.CropBottom = 40

'Format the worksheet
With oSheet.Range("A2:Q2")
.Font.Bold = True
.EntireColumn.AutoFit
End With

'oSheet.Protect
'Save the Workbook and Quit Excel
If FNew = "YES" Then
oBook.SaveAs "D:\TEXTILES\Textiles.xls"
Else
oBook.Save
End If
MsgBox "Record added successfully"
oBook.Close
oExcel.Quit

Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing

ExitHere:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox Err.Description & " " & Err.Number
Resume ExitHere
End Select
oBook.Close savechanges:=False

End Sub[/VBA]

My question now is, is there any way for me to protect the workbook after the first time creation and close the workbook and yet allow them to enter new record later. As you can see from my code that I have tried to use protect/unprotect, but it seems that after I close the application, the next time I opened it, an error message appears saying it is protected. Am I supposed to put in admin password and use that to re-open it later? Thanks again.

[mdmackillop]

Try this. I've added the password PW to the code
[VBA]
Private Sub ADD_Click()

Dim oExcel As Excel.Application
Dim oBook, oSheet, pic As Object
Dim i, PicLocation, MyRange, FNew As String
Dim r, l As Long
Dim DataArray(1 To 1, 1 To 16) As Variant
Dim TargetCell As Range

On Error GoTo HandleErr
Set oExcel = New Excel.Application

' check file exist or not
If Len(Dir("D:\TEXTILES\Textiles.xls")) = 0 Then
'This file does NOT exist
'Start a new workbook in Excel
FNew = "YES"
Set oBook = oExcel.Workbooks.Add
'Add headers to the worksheet on row 1
Set oSheet = oBook.Worksheets(1)
oSheet.Range("A1:Q1").Value = Array("COUNTRY CODE", "PRODUCT CODE", "DESCRIPTION", _
"COST PRICE", "SELLING PRICE", "LENGTH", _
"COMMENTS", "HOT ITEM", "ORDER'S DATE", _
"COLOUR GIVEN DATE", "ITEM NUMBER", "FACTORY", _
"PRICE (USD)", "QUANTITY", "AMOUNT (USD)", _
"SHIPMENT", "IMAGE")
Else
'This file does exist
FNew = "NO"
Set oBook = Workbooks.Open("D:\TEXTILES\Textiles.xls")
Set oSheet = oBook.Worksheets(1)
oSheet.Unprotect "PW"
End If

'Not Used
'Range("Q2").Select
'MyRange = Selection.Address

r = LastRow(oSheet.UsedRange)
r = r + 1

'Create an array with 16 columns and 1 rows
DataArray(1, 1) = CountryCode.Value
DataArray(1, 2) = ProductCode.Value
DataArray(1, 3) = Description.Value
DataArray(1, 4) = CostPrice.Value
DataArray(1, 5) = SellingPrice.Value
DataArray(1, 6) = CInt(Length.Value)
DataArray(1, 7) = Comments.Value
DataArray(1, 8) = HotItem.Value
DataArray(1, 9) = OrdersDate.Value
DataArray(1, 10) = ColorGivenDt.Value
DataArray(1, 11) = Item.Value
DataArray(1, 12) = Factory.Value
DataArray(1, 13) = PriceUSD.Value
DataArray(1, 14) = CInt(Quantity.Value)
DataArray(1, 15) = AmountUSD.Value
DataArray(1, 16) = Shipment.Value

'Transfer the array to the worksheet starting at the next empty row
oSheet.Range("A" & r).Resize(1, 16).Value = DataArray

'insert an image
Set TargetCell = oSheet.Cells(oSheet.Rows.Count, 17).End(xlUp).Offset(r - 1)
PicLocation = Application.GetSaveAsFilename("C:\", "Image Files (*.jpg),*.jpg", , "Specify Image Location")
Set pic = oSheet.Pictures.Insert(PicLocation)
pic.Top = TargetCell.Top
pic.Left = TargetCell.Left
pic.Width = pic.Width / 5
pic.Height = pic.Height / 5
pic.ShapeRange.PictureFormat.CropRight = 20
pic.ShapeRange.PictureFormat.CropBottom = 40

'Format the worksheet
With oSheet.Range("A2:Q2")
.Font.Bold = True
.EntireColumn.AutoFit
End With

oSheet.Protect "PW"
'Save the Workbook and Quit Excel
If FNew = "YES" Then
oBook.SaveAs "D:\TEXTILES\Textiles.xls"
Else
oBook.Save
End If
MsgBox "Record added successfully"
oBook.Close
oExcel.Quit

Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing

ExitHere:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox Err.Description & " " & Err.Number
Resume ExitHere
End Select
oBook.Close savechanges:=False

End Sub
[/VBA]

[freefly]

thanks, I will definitely give this a try. other questions:
1. how do I post back the image that I have inserted during addition of the record to the display screen? Can I display the image onto a label?
2. how do i complie these macro into a single .exe file for my user to use? (they can just click on image that I put on the .exe file). Is there any way that I can block the code behind it so that my user won'ty edit the code behind?