asked on

Pls help me expand my horizons in Excel VBA Class Modules?

I have the need to expand my horizons from functions and subs into classes and remote instancing. I want(need) to be able to reuse my code. I have the information I need on remote instancing in VBA so I'm good there for now. What I am looking for is a bit of a short cut to the maturity of my understanding of the practical usage of classes in VBE. Rather than spend a year maturing as I fumble through it, the fresh perspective of someone else would likely give the turbo charge i'm looking for.

I have read and understood [URL= http://www.cpearson.com/excel/classes.aspx] this page by Cpearson[/URL]. I have an understanding of OOP and a good working knowledge of VBE, but I am certainly not the best programmer in the world...

I have these subroutines that I would like to convert into a class module named pics that would manage these same things, but of course using OOP strategies.

Below are the names of the current subroutines:
savePicAsCustomerOverheadJPEG
savePicAsCustomerDirectionsJPEG
savePicAsSafeRoomDrawingJPEG
loadSavedNcpPictures
exportPictureAs

(This code was in one of my worksheet mods)

Public Sub savePicAsCustomerOverheadJPEG()
 
    Dim dPicture As Scripting.Dictionary
    ' shp As Shape, shpRng As ShapeRange, strFileName As String
   
    Dim strFileName As String
    Set dPicture = New Dictionary
    Dim shp As Shape
   
    'Debug.Print activesheet.Shapes(selection.ShapeRange.Name).Name
   
    If Not activesheet.Shapes(selection.ShapeRange.Name).Name Like "Group*" And Not activesheet.Shapes(selection.ShapeRange.Name).Name Like "Picture*" Then
        MsgBox "Group not selected"
        Exit Sub
    End If
   
    Set dPicture.Item("shp") = activesheet.Shapes(selection.ShapeRange.Name)
    Set dPicture.Item("shpRng") = selection.ShapeRange
 
    dPicture.Add "Name", Range("po_pw_customer_name").Value
    dPicture.Add "picType", "overhead_view"
    dPicture.Add "path", ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator
    dPicture.Add "fn", "JPEG" 'export filter name
    dPicture.Add "fne", ".jpg" 'file name ext
    dPicture.Add "picName", "overhead_view"
   
    exportPictureAs dPicture
   
    dPicture.Item("shp").Delete
   
End Sub


Public Sub savePicAsCustomerDirectionsJPEG()
 
    Dim dPicture As Scripting.Dictionary
    ' shp As Shape, shpRng As ShapeRange, strFileName As String
   
    Dim strFileName As String
    Set dPicture = New Dictionary
    Dim shp As Shape
   
    Set dPicture.Item("shp") = activesheet.Shapes(selection.ShapeRange.Name)
    Set dPicture.Item("shpRng") = selection.ShapeRange
   
    dPicture.Add "Name", Range("po_pw_customer_name").Value
    dPicture.Add "picType", "directions"
    dPicture.Add "path", ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator
    dPicture.Add "picName", "driving_directions"
    dPicture.Add "fn", "JPEG"
    dPicture.Add "fne", ".jpg"
   
    exportPictureAs dPicture
   
    dPicture.Item("shp").Delete
   
End Sub


Public Sub savePicAsSafeRoomDrawingJPEG()
   
    Dim dPicture As Scripting.Dictionary
    ' shp As Shape, shpRng As ShapeRange, strFileName As String
   
    Dim strFileName As String
    Set dPicture = New Dictionary
    Dim shp As Shape
   
    Set dPicture("shp") = activesheet.Shapes(selection.ShapeRange.Name)
    Set dPicture("shpRng") = selection.ShapeRange
   
    dPicture.Add "Name", Range("po_pw_customer_name").Value
    dPicture.Add "picType", "safe_room_drawing"
    dPicture.Add "path", ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator
    dPicture.Add "picName", "safe_room_drawing"
    dPicture.Add "fn", "JPEG"
    dPicture.Add "fne", ".jpg"
   
    exportPictureAs dPicture
   
    dPicture("shp").Delete
   
End Sub


Sub loadSavedNcpPictures()
 
    custName = Range("po_pw_customer_name").Value
   
    'Load and Position Overhead View
    ohViewPath = ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator & custName & "_overhead_view.jpg"
    If Dir(ohViewPath) <> "" Then
        Dim ohViewJPG As Object
        Set ohViewJPG = activesheet.Pictures.Insert(ohViewPath)
       
        ohViewJPG.ShapeRange.Name = "from_disk_" & ohViewJPG.ShapeRange.Name
       
        'Position in the middle of the cooresponding cells
        ' Is the aspect ratio compared to the cell: Too wide, or too tall, or exactly the same ratio?
        With Sheets("SF, FT, & UGg - PO PW").Range("overhead_view").MergeArea
           
            ' Get the HtoWRatio compared to the cell that it is populating
            HtoWRatio = (ohViewJPG.Height / .Height) / (ohViewJPG.Width / .Width)
           
            ' A result of greater than 1 indicates an image of narrower aspect ratio than it's owner cell's,
            ' A result of less than 1 indicates an image of wider aspect ratio than it's cell's aspect ratio
            narrowerImageAspectRatio = HtoWRatio > 1
           
            If narrowerImageAspectRatio Then
               
                '  If it is a narrower aspect ratio, or exactly the same aspect ratio, size the picture to the cell height - 10px (5px margin) &...
                ohViewJPG.Height = .Height - 10
                '  Position this vertically 5px from the top of the cell
                ohViewJPG.Top = .Top + 5
               
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                ohViewJPG.Left = .Left + (.Width - ohViewJPG.Width) / 2
               
            Else
               
                '  If it is a wider, scale it to the cell width - 10
                ohViewJPG.Width = .Width - 10
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                ohViewJPG.Left = .Left + 5
               
                '  What are amount of pixels to add to .top to center the picture in the cell vertically?
                ohViewJPG.Top = .Top + ((.Height - ohViewJPG.Height) / 2)
            End If
        End With
    Else
        MsgBox "Overhead View Not Found.", vbOKOnly, "Overhead View Status..."
    End If
   
    'Load and Position Driving Directions
    ddViewPath = ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator & custName & "_directions.jpg"
    If Dir(ddViewPath) <> "" Then
        Dim ddViewJPG As Object
        Set ddViewJPG = activesheet.Pictures.Insert(ddViewPath)
       
        'Position in the middle of the cooresponding cells
        ' Is the aspect ratio compared to the cell: Too wide, or too tall, or exactly the same ratio?
        With Sheets("SF, FT, & UGg - PO PW").Range("driving_directions").MergeArea
           
            ' Get the HtoWRatio compared to the cell that it is populating
            HtoWRatio = (ddViewJPG.Height / .Height) / (ddViewJPG.Width / .Width)
           
            ' A result of greater than 1 indicates an image of narrower aspect ratio than it's owner cell's,
            ' A result of less than 1 indicates an image of wider aspect ratio than it's cell's aspect ratio
            narrowerImageAspectRatio = HtoWRatio > 1
           
            If narrowerImageAspectRatio >= True Then
                
                '  If it is a narrower aspect ratio, or exactly the same aspect ratio, size the picture to the cell height - 10px (5px margin) &...
                ddViewJPG.Height = .Height - 10
                '  Position this vertically 5px from the top of the cell
                ddViewJPG.Top = .Top + 5
               
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                ddViewJPG.Left = .Left + (.Width - ddViewJPG.Width) / 2
               
            Else
               
                '  If it is a wider, scale it to the cell width - 10
                ddViewJPG.Width = .Width - 10
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                ddViewJPG.Left = .Left + 5
               
                '  What are amount of pixels to add to .top to center the picture in the cell vertically?
                ddViewJPG.Top = .Top + ((.Height - ddViewJPG.Height) / 2)
                           
            End If
        End With
    Else
        MsgBox "Driving Directions View Not Found.", vbOKOnly, "Driving Directions Image View Status..."
    End If
   
    'Load and Position the Safe Room Drawing
    SrDrawingPath = ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator & custName & "_safe_room_drawing.jpg"
    If Dir(SrDrawingPath) <> "" Then
        Dim SrDrawingJPG As Object
        Set SrDrawingJPG = activesheet.Pictures.Insert(SrDrawingPath)
       
        'Position in the middle of the cooresponding cells
        ' Is the aspect ratio compared to the cell: Too wide, or too tall, or exactly the same ratio?
       With Sheets("SF, FT, & UGg - PO PW").Range("safe_room_drawing").MergeArea
           
            ' Get the HtoWRatio compared to the cell that it is populating
            HtoWRatio = (SrDrawingJPG.Height / .Height) / (SrDrawingJPG.Width / .Width)
           
            ' A result of greater than 1 indicates an image of narrower aspect ratio than it's owner cell's,
            ' A result of less than 1 indicates an image of wider aspect ratio than it's cell's aspect ratio
            narrowerImageAspectRatio = HtoWRatio > 1
           
            If narrowerImageAspectRatio >= True Then
               
                '  If it is a narrower aspect ratio, or exactly the same aspect ratio, size the picture to the cell height - 10px (5px margin) &...
                SrDrawingJPG.Height = .Height - 10
                '  Position this vertically 5px from the top of the cell
                SrDrawingJPG.Top = .Top + 5
               
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                SrDrawingJPG.Left = .Left + (.Width - SrDrawingJPG.Width) / 2
                
            Else
                
                '  If it is a wider, scale it to the cell width - 10
                SrDrawingJPG.Width = .Width - 10
                '  What are amount of pixels needed that's needed to add to .left to center the picture in the cell vertically?
                SrDrawingJPG.Left = .Left + 5
               
                '  What are amount of pixels to add to .top to center the picture in the cell vertically?
                SrDrawingJPG.Top = .Top + ((.Height - SrDrawingJPG.Height) / 2)
            End If
        End With
    Else
        MsgBox "Driving Directions View Not Found.", vbOKOnly, "Driving Directions Image View Status..."
    End If
   
End Sub
 
 
Sub exportPictureAs(picDetails As Scripting.Dictionary)
'--
' Description: Save shape as .JPEG
' Potential problem: At next export image file name begins again from the 'CameraPic1'...
' (To eliminate this problem, you can include the date and time the file name.)
'--
    '--
    'Create temporary embedded Excel Chart
    '  Copy the picture
    picDetails.Item("shp").CopyPicture
   
    '  (Add & then Customize Chart(picture) dimensions)
    picDetails.Add "objChart", activesheet.ChartObjects.Add(Sheets("SF, FT, & UGg - PO PW").Range(picDetails("picName")).Left + 5, Sheets("SF, FT, & UGg - PO PW").Range(picDetails("picName")).Top + 5, picDetails.Item("shp").Width, picDetails.Item("shp").Height)
   
    '  Copy the picture to the chart
    picDetails.Item("objChart").Activate
    ActiveChart.Paste
   
    ' Export Picture as JPEG
    ActiveChart.Export Filename:=picDetails.Item("path") & picDetails("Name") & "_" & picDetails.Item("picType") & picDetails.Item("fne"), _
    FilterName:=picDetails.Item("fn")
   
    'Clean up
    picDetails.Item("objChart").Delete
    Set picDetails.Item("objChart") = Nothing
   
End Sub

Open in new window

Obviously my picture mgmt strategy could use some refining, and is incomplete from where it stands, but oop will probably help me speed up the process, i'm guessing...

Chris Raisin

Looking into it now for you...I would find it helpful to have data to work with so I can test the code. Is it possible to obtain your worksheet provided nothing is confidential? Perhaps dummy data (pictures) could be used.

Cheers....Chris (Melbourne-Australia)

SOLUTION

Chris Raisin

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

aikimark

It looks like you want to replace a dictionary object with a class object. If so, this is the minimum of what you need in your class module.

Option Explicit

Public shp As Shape
Public shpRng As ShapeRange
Public Name As String
Public picType As String
Public path As String
Public fn As String
Public fne As String
Public picName As String

Open in new window

Using the class object in your exportPictureAs() routine:

Sub exportPictureAs(picDetails As clsDetails)
'--
' Description: Save shape as .JPEG
' Potential problem: At next export image file name begins again from the 'CameraPic1'...
' (To eliminate this problem, you can include the date and time the file name.)
'--
    Dim oChart As ChartObject
    '--
    'Create temporary embedded Excel Chart
    '  Copy the picture
    picDetails.shp.CopyPicture
   
    '  (Add & then Customize Chart(picture) dimensions)
    Set oChart = ActiveSheet.ChartObjects.Add(Sheets("SF, FT, & UGg - PO PW").Range(picDetails.picName).Left + 5, Sheets("SF, FT, & UGg - PO PW").Range(picDetails.picName).Top + 5, picDetails.shp.Width, picDetails.shp.Height)
   
    '  Copy the picture to the chart
    oChart.Select
    ActiveChart.Paste
   
    ' Export Picture as JPEG
    ActiveChart.Export Filename:=picDetails.path & picDetails.Name & "_" & picDetails.picType & picDetails.fne, _
                        FilterName:=picDetails.fn
   
    'Clean up
    Set oChart = Nothing
   
End Sub

Open in new window

Here is one of your other module routines converted to use the class.

Public Sub savePicAsCustomerOverheadJPEG()
 
    Dim dPicture As New clsDetails
    ' shp As Shape, shpRng As ShapeRange, strFileName As String
   
    Dim strFileName As String
    Dim shp As Shape
   
    'Debug.Print activesheet.Shapes(selection.ShapeRange.Name).Name
   
    If Not ActiveSheet.Shapes(Selection.ShapeRange.Name).Name Like "Group*" And Not ActiveSheet.Shapes(Selection.ShapeRange.Name).Name Like "Picture*" Then
        MsgBox "Group not selected"
        Exit Sub
    End If
   
    Set dPicture.shp = ActiveSheet.Shapes(Selection.ShapeRange.Name)
    Set dPicture.shpRng = Selection.ShapeRange
 
    dPicture.Name = Range("po_pw_customer_name").Value
    dPicture.picType = "overhead_view"
    dPicture.path = ActiveWorkbook.path & Application.PathSeparator & "Customer Images" & Application.PathSeparator
    dPicture.fn = "JPEG" 'export filter name
    dPicture.fne = ".jpg" 'file name ext
    dPicture.picName = "overhead_view"
   
    exportPictureAs dPicture
   
End Sub

Open in new window

Note: you should always use explicit variable declaration. Add an

Option Explicit

Open in new window

statement to all your general declarations sections.

Chris Raisin

What I have already state din my answer, except the code supplied above is not fully object orientedand can be shown in one class only, not calls to procedures that simply use part of a class.

The procedure "savePicAsCustomerOverheadJPEG" is actually a method of the class (SavePicture).

I will finish off my code and post it shortly.

Cheers
Chris

Chris Raisin

This is the code for the Class Object.

I still have to finish the code for "LoadPictures" (stand by for that).
I am not sure where you actually call that. I gather it may be a seperate macro, so you simply "LoadPictures" and then "SavePictures" (producing three different types). Am I correct?

I also attach the "stem" code (the macro that "kicks off" the saving of the pictures as three types). I have not tested this since I have no worksheet to play with, but you should be able to tweak where necessary to fix any problems.

The Class Code (incomplete at the moment awaiting for method "ImportPicture")

Option Explicit

Private mvarstrFilterName As String 'local copy
Private mvarstrName As String 'local copy
Private mvarstrPath As String 'local copy
Private mvarstrPicName As String 'local copy
Private mvarstrPicType As String 'local copy
Private mvarstrShapeName As String 'local copy
Private mvarstrShapeRange As Range 'local copy
Private mvarstrFileDateTime As String 'local copy
Private mvarChart As Chart ' local copy

Public Sub ImportPicture(FilePathAndName As String)
End Sub

Public Sub ExportPicture(oPH As PictureHandler, strPT As String)
      With oPH
        .strPicType = strPT
        .strFilterName = "JPEG"
        .strFileNameExt = "." & LCase(strFN)
        .strPicName = strPT
        .strShapeRange.CopyPicture
        Set .Chart = ActiveSheet.ChartObjects.Add(Sheets("SF, FT, & UGg - PO PW").Range(.strPicName).Left + 5, Sheets("SF, FT, & UGg - PO PW").Range(.strPicName), Top + 5, .strShapeRange.Width, .strShapeRange.Height)
        .Chart.Activate
        ActiveChart.Paste
        ActiveChart.Export Filename:=.strPath & .strName & "_" & .strPicType & .strFileNameExt, filtername:=.strFilterName
        .Chart.Delete
        Set .Chart = Nothing
      End With
End Sub

Public Property Let strFileDateTime(ByVal vData As String)
    mvarstrFileDateTime = vData
End Property

Public Property Get strFileDateTime() As String
    strFileDateTime = mvarstrFileDateTime
End Property

Public Property Let strShapeRange(ByVal vData As Range)
    mvarstrShapeRange = vData
End Property

Public Property Get strShapeRange() As Range
    strShapeRange = mvarstrShapeRange
End Property

Public Property Let strShapeName(ByVal vData As String)
    mvarstrShapeName = vData
End Property

Public Property Get strShapeName() As String
    Set strShapeName = mvarstrShapeName
End Property

Public Property Let Chart(ByVal vData As Chart)
    mvarChart = vData
End Property

Public Property Get Chart() As Chart
    Set Chart = mvarChart
End Property

Public Property Let strPicType(ByVal vData As String)
    mvarstrPicType = vData
End Property

Public Property Get strPicType() As String
    strPicType = mvarstrPicType
End Property

Public Property Let strPicName(ByVal vData As String)
    mvarstrPicName = vData
End Property


Public Property Get strPicName() As String
    strPicName = mvarstrPicName
End Property

Public Property Let strPath(ByVal vData As String)
    mvarstrPath = vData
End Property


Public Property Get strPath() As String
    strPath = mvarstrPath
End Property

Public Property Let strName(ByVal vData As String)
    mvarstrName = vData
End Property

Public Property Get strName() As String
    Set strName = mvarstrName
End Property

Public Property Let strFilterName(ByVal vData As String)
    mvarstrFilterName = vData
End Property

Public Property Get strFilterName() As String
    strFilterName = mvarstrFilterName
End Property

Public Property Let strFileNameExt(ByVal vData As String)
    mvarstrFileNameExt = vData
End Property

Public Property Get strFileNameExt() As String
    strFileNameExt = mvarstrFileNameExt
End Property

Open in new window

Now here is the code that is used to "ExportPicture" three times.
It will be changed to incorporate a call to "ImportPicture" (when it is written) "ImportPicture" will be called first and then the "ExportPicture" will run thrice.

Option Explicit

Private Sub ProcessPicture()
   Dim oWsh As Worksheet
   Set oWsh = Application.ActiveSheet
   Dim oHandler As New PictureHandler
   If Not oWsh.Shapes(Selection.ShapeRange.Name).Name Like "Group*" And Not oWsh.Shapes(Selection.ShapeRange.Name).Name Like "Picture*" Then
        MsgBox "Group not selected"
        Exit Sub
    End If
    With oHandler
      .strShapeName = ActiveSheet.Shapes(Selection.ShapeRange.Name)
      .strShapeRange = Selection.ShapeRange
      .strName = Range("po_pw_customer_name").Value
      .strPath = ActiveWorkbook.Path & Application.PathSeparator & "Customer Images" & Application.PathSeparator
      .ExportPicture oHandler, "overhead_view"     'Picture Type
      .ExportPicture oHandler, "directions"        'Picture Type
      .ExportPicture oHandler, "safe drawing room" 'Picture Type
    End With
End Sub

Open in new window

I am sorry about the lack of comments, but I am trying to get this finished ASAP for you, and I will then put in the comments to make things easier to understand. It is now 2.15am so I had better get some "shut-eye" :-)

Cheers
Chris

ASKER CERTIFIED SOLUTION

Chris Raisin

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

fjjlee

ASKER

So sorry all. got locked out of my account and every time I would reset the password it took like 30 min to receive the reset. By that time I had moved on to 52 other items.

Thank you so much for all your help and interest. I will work to look through them all over the next few days and post as possible.

I have sensitive data in this spreadsheet. No double I can make a copy that allows for easier demonstration purposes without that though. I will get a copy posted. I will post back when ready.

fjjlee

ASKER

Okay, I still haven't had time to read all of it, but "WOW' on all accounts. Thank you so much craisin for your help and attention. You are an amazingly helpful person & I think you did very well given the limitations of no data. (and so sorry about that)

And Yes, aikimark, it is a very astute observation that the dictionary object is much of the replacement.

I will look over both of your contributions and post a version myself in the next couple of days. Maybe tonight if I can't pull myself away. :-) curtime; 12:15 am...

fjjlee

ASKER

Thanks for all your help.