Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Need Macro to create a new worksheet and insert image
Hi I need a macro that will create a new worksheet and insert an image into
it based on all the images in a particular directory. The worksheet name should be the name of the image file. Where do I start? |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Need Macro to create a new worksheet and insert image
This should get you started:
Option Explicit Sub testme() Dim myNames() As String Dim fCtr As Long Dim myFile As String Dim myPath As String Dim myExt As String Dim NewWks As Worksheet Dim myPict As Picture 'change to point at the folder to check myPath = "C:\yourpathtothepictures" If Right(myPath, 1) < "\" Then myPath = myPath & "\" End If myFile = Dir(myPath & "*.*") If myFile = "" Then MsgBox "no files found" Exit Sub End If 'get the list of files fCtr = 0 Do While myFile < "" If InStr(1, myFile, ".", vbTextCompare) = 0 Then 'do nothing, no extension Else myExt = LCase(Mid(myFile, InStrRev(myFile, "."))) Select Case myExt Case Is = ".jpg", ".bmp", ".tif", ".tiff" fCtr = fCtr + 1 ReDim Preserve myNames(1 To fCtr) myNames(fCtr) = myFile End Select End If 'keep looking myFile = Dir() Loop Application.ScreenUpdating = False If fCtr 0 Then For fCtr = LBound(myNames) To UBound(myNames) Set NewWks = Worksheets.Add NewWks.Move after:=Sheets(Sheets.Count) On Error Resume Next NewWks.Name = myNames(fCtr) If Err.Number < 0 Then Err.Clear MsgBox "Rename failed on: " & vbLf _ & NewWks.Name End If On Error GoTo 0 Set myPict = NewWks.Pictures.Insert _ (Filename:=myPath & myNames(fCtr)) Next fCtr End If End Sub If you're new to macros: Debra Dalgleish has some notes how to implement macros he http://www.contextures.com/xlvba01.html David McRitchie has an intro to macros: http://www.mvps.org/dmcritchie/excel/getstarted.htm Ron de Bruin's intro to macros: http://www.rondebruin.nl/code.htm (General, Regular and Standard modules all describe the same thing.) wrote: Hi I need a macro that will create a new worksheet and insert an image into it based on all the images in a particular directory. The worksheet name should be the name of the image file. Where do I start? -- Dave Peterson |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Need Macro to create a new worksheet and insert image
ps. This used instrrev() and that was added in xl2k. So if you need to support
xl97 or earlier, this won't work without modification. Dave Peterson wrote: This should get you started: Option Explicit Sub testme() Dim myNames() As String Dim fCtr As Long Dim myFile As String Dim myPath As String Dim myExt As String Dim NewWks As Worksheet Dim myPict As Picture 'change to point at the folder to check myPath = "C:\yourpathtothepictures" If Right(myPath, 1) < "\" Then myPath = myPath & "\" End If myFile = Dir(myPath & "*.*") If myFile = "" Then MsgBox "no files found" Exit Sub End If 'get the list of files fCtr = 0 Do While myFile < "" If InStr(1, myFile, ".", vbTextCompare) = 0 Then 'do nothing, no extension Else myExt = LCase(Mid(myFile, InStrRev(myFile, "."))) Select Case myExt Case Is = ".jpg", ".bmp", ".tif", ".tiff" fCtr = fCtr + 1 ReDim Preserve myNames(1 To fCtr) myNames(fCtr) = myFile End Select End If 'keep looking myFile = Dir() Loop Application.ScreenUpdating = False If fCtr 0 Then For fCtr = LBound(myNames) To UBound(myNames) Set NewWks = Worksheets.Add NewWks.Move after:=Sheets(Sheets.Count) On Error Resume Next NewWks.Name = myNames(fCtr) If Err.Number < 0 Then Err.Clear MsgBox "Rename failed on: " & vbLf _ & NewWks.Name End If On Error GoTo 0 Set myPict = NewWks.Pictures.Insert _ (Filename:=myPath & myNames(fCtr)) Next fCtr End If End Sub If you're new to macros: Debra Dalgleish has some notes how to implement macros he http://www.contextures.com/xlvba01.html David McRitchie has an intro to macros: http://www.mvps.org/dmcritchie/excel/getstarted.htm Ron de Bruin's intro to macros: http://www.rondebruin.nl/code.htm (General, Regular and Standard modules all describe the same thing.) wrote: Hi I need a macro that will create a new worksheet and insert an image into it based on all the images in a particular directory. The worksheet name should be the name of the image file. Where do I start? -- Dave Peterson -- Dave Peterson |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Need Macro to create a new worksheet and insert image
Thank you so much, it worked perfectly.
"Dave Peterson" wrote: This should get you started: Option Explicit Sub testme() Dim myNames() As String Dim fCtr As Long Dim myFile As String Dim myPath As String Dim myExt As String Dim NewWks As Worksheet Dim myPict As Picture 'change to point at the folder to check myPath = "C:\yourpathtothepictures" If Right(myPath, 1) < "\" Then myPath = myPath & "\" End If myFile = Dir(myPath & "*.*") If myFile = "" Then MsgBox "no files found" Exit Sub End If 'get the list of files fCtr = 0 Do While myFile < "" If InStr(1, myFile, ".", vbTextCompare) = 0 Then 'do nothing, no extension Else myExt = LCase(Mid(myFile, InStrRev(myFile, "."))) Select Case myExt Case Is = ".jpg", ".bmp", ".tif", ".tiff" fCtr = fCtr + 1 ReDim Preserve myNames(1 To fCtr) myNames(fCtr) = myFile End Select End If 'keep looking myFile = Dir() Loop Application.ScreenUpdating = False If fCtr 0 Then For fCtr = LBound(myNames) To UBound(myNames) Set NewWks = Worksheets.Add NewWks.Move after:=Sheets(Sheets.Count) On Error Resume Next NewWks.Name = myNames(fCtr) If Err.Number < 0 Then Err.Clear MsgBox "Rename failed on: " & vbLf _ & NewWks.Name End If On Error GoTo 0 Set myPict = NewWks.Pictures.Insert _ (Filename:=myPath & myNames(fCtr)) Next fCtr End If End Sub If you're new to macros: Debra Dalgleish has some notes how to implement macros he http://www.contextures.com/xlvba01.html David McRitchie has an intro to macros: http://www.mvps.org/dmcritchie/excel/getstarted.htm Ron de Bruin's intro to macros: http://www.rondebruin.nl/code.htm (General, Regular and Standard modules all describe the same thing.) wrote: Hi I need a macro that will create a new worksheet and insert an image into it based on all the images in a particular directory. The worksheet name should be the name of the image file. Where do I start? -- Dave Peterson . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Insert image in a protected Excel worksheet | Excel Discussion (Misc queries) | |||
trying to create an insert row macro | Excel Discussion (Misc queries) | |||
Macro doesn't insert image when spreadsheet is protected | Excel Worksheet Functions | |||
Hyperlink to an image in other worksheet, displaying entire image. | Excel Worksheet Functions | |||
how do I create a macro to auto insert rows? | Excel Worksheet Functions |