Solved

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

Posted on 2014-10-11
9
313 Views
Last Modified: 2014-10-17
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...
0
Comment
Question by:fjjlee
  • 5
  • 3
9 Comments
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 40375421
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)
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 500 total points
ID: 40375579
Just some first thoughts .

I think all your code can be handled by one class as follows:

CLASS DEFINITION:
(No code yet, just a plan on class properties and methods)
...Sorry about the aligning - it is hard to do in the Experts Exchange Editor :-(
   Class:          PictureHandler

   Properties:   strFileNameExt   String
                        strFilterName     String
                        strName              String
                        strPath                 String
                        strPicName          String
                        strPicType             String
                        strShapeName     String
                        strShapeRange     String
                        strFileDateTime     String

  Methods:      ExportPicture ()
                        ImportPicture (FilePathAndName as string)  
   

Open in new window


CODING:       (sample of how code would be handled in VBA macro)    

              Dim oHandler                    as PictureHandler
              Dim ImagePath                  as String

              set oHandler = New PictureHandler
              '........
              '........
              '........
              '(code to fill the eight Properties of oHandler)
              ImagePath = ActiveWorkbook.Path & _
                                   Application.PathSeparator & _
                                   "Customer Images" & _
                                   Application.PathSeparator & _
                                   custName & _
                                   "_overhead_view.jpg" 
              oHandler.ImortPicture(ImagePath)
             ' ........
             ' ........
             '(and when you want to export)
              oHandler.ExportPicture()    

Open in new window


This is just very rough, without actually working on data and real code.

You basically replace each call for each different "type" of picture (Customer Overhead, Customer Drawings, Safe Room Overhead) with one call to the ImageHandler, just passing it the full filename (Path and filename).

Since the code in each instance appears to do the same thing (with just different data), your code is an ideal candidate for Classing.

Whenever you see code doing the same sort of thing with data that code you have previously written (but you just test for changes to name/type/etc.)
then a class can usually save you a lot of coding.

Once you agree that this looks feasible I will do some coding for the class for you.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40375613
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.
0
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 40375628
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
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 13

Expert Comment

by:Chris Raisin
ID: 40375736
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
0
 
LVL 13

Accepted Solution

by:
Chris Raisin earned 500 total points
ID: 40375797
OK, I have finished as much as I can without data to test. I have not commented it, since it is getting very late and I have spent a lot of time on this. (Besides, if you go in to comment it yourslef it will help you develop your thoughts on the Class and its properties and methods). If you have any questions, just leave another comment.

I have changed the "core" code to run the "Import" before the "export" each time. I am not sure of the order in which you are executing everything, so you may have to move lines around to get them to execute in the correct order.

There were a few "typos" in my earlier code which I have corrected.
(I also noticed your "MsgBox" message for "Safe Room drawing" not being found (in LoadSavedNcpPictures) was incorrect. It states the error happens with "Driving Directions" instead of "Safe Room Drawing")

I have also incorporated the date and time as part of the filename when it is exported, to overcome the potantial problem of "duplicate names" (as indicated in your code).

The full code ready for you to muck around with show below, It will hopefully achieve correct results using solely object orientation by way of a class.

"Core" Macro which I have called: "ProcessPicture"

Option Explicit
'Note: You must reference the Microsoft Excel 14.0 Object Library if running this code
'      outside of Excel.

Private Sub ProcessPicture()
   ' Macro to save shapes in the workbook as .JPEG files
   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
      strDateTime = FileDateTime(.strPath)
      .ImportPicture .strPath, "overhead_view"
      .ExportPicture oHandler, "overhead_view", strDateTime
      .ImportPicture .strPath, "driving_directions"
      .ExportPicture oHandler, "driving_directions", strDateTime
      .ImportPicture .strPath, "safe_room_drawing"
      .ExportPicture oHandler, "safe_room_drawing", strDateTime
    End With
End Sub

Open in new window


The full code now for the Class (including both Import and Export methods) show below.

You will note the standard "skeleton" for a class is a whole set of memvars (memory variables) which are declared at the top of the class as private (private to the class).

These variables are used to "let and get" data into and out of the  properties of an instance of the class. When you assign a value to a class property
(e.g.  oHandler.strShapeRange = Selection.ShapeRange) the object of the class which you have created ("instantiated") using the word "new", "sets" (or rather "lets") the value to the memvar in the classes coding. When you want value back for a property of a class object, the class "gets" the value held in the memvar and sends it to the calling program.

It is important to grasp that every time you create an instance of a class (i.e. define an object  as being an instance of the class using coding such as "Dim oTC as ThisClass"  and "set oTC = new ThisClass" yu are creating a completely seperate instance of all the values handled by this code, all stored in its own seperate memory allocation. You could call the "New" operator hundreds of times and create hundreds of objects all running on this same class code, but keeping all the values seperate. (Pretty snazzy, huh? :-)

Object Orintation (class coding) makes programming so much easier, as you can see in this attempt.  The repetitive coding has gone and it is so much easier to make slight changes in one place only when needed.

You may notice the use of the "Select Case" structure in the "ImportPicture" method. This isoften used so that we did use code multiple times, making alterations where required based on the values passed as parameters to a procedure ora method.

Class methods equate to VB "subroutines" (they do things). The properties are a little like "functions" in that they sometimes return values via the "get" procedure within the Class.

With full object orintation there are also "Events" which a class controls. Thisis when something "happens" in the program (such as a cell in a worksheet changes value).

If you ever progress onto VB.Net you will find it is totally object opriented, where everything (even "subs") are classes! (It's a good thing Visual Studio writes most of the code for you! LOL  :-)

One final point, make sure the code for the "Class" is placed in a "Class Module" ine the VBA editor, not a "normal" module. Click on "Insert" then select "Class Module" instead of module, then paste the code in that module.
The other code of course just goes in a normal module. If you do not place the class code in a class module, the compiler will not be able to compile it or run the macro.
 
Anyway, here is the class code (slightly altered from the earlier version).

I hope all this help you in your OO (Object Oriented) Class development. :-)
(Don't hesitate to get back to me if you have any questions. Iamsure there will be glitches in the code since  things MAY be screwy....(remember, I had no data to work with so it is untested)  :-)


Cheers
Chris


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, strType As String)
  Dim oJPG As Object
  Dim HToWRation As Integer
  Dim bNarrowerImageAspectRatio As Boolean
  Dim strTitle As String
  Dim strError As String
  If FilePathAndName <> "" Then
    Set oJPG = Application.ActiveSheet.Pictures.Insert(FilePathAndName)
    oJPG.ShapeRange.Name = "from_disk_" & oJPG.ShapeRange.Name
    With Sheets("SF, FT, & Ug - po pw").Range("overhead_view").MergeArea
      HtoWRatio = (oJPG.Height / .Height) / (oJPG.Width / .Width)
      bNarrowerImageAspectRatio = (HtoWRatio > 1)
      If bNarrowerImageAspectRatio Then
        oJPG.Height = .Height - 10
        oJPG.Top = .Top + 5
        oJPG.Left = .Left + (.Width - oJPG.Width) / 2
      Else
        oJPG.Width = .Width - 10
        oJPG.Left = .Left + 5
        oJPG.Top = .Top + ((.Height - oJPG.Height) / 2)
      End If
    End With
  Else
    Select Case LCase(strType)
      Case "overhead_view"
        strTitle = "Overhead View Status..."
        strError = "Overhead View Not Found."
      Case "driving_directions"
        strTitle = "Driving Directions Image View Status..."
        strError = "Driving Directions View Not Found."
      Case "safe_room_drawing"
        strTitle = "Safe Room Drawing View Status..."
        strError = "Safe Room Drawing View not found."
    End Select
    MsgBox strError, vbOKOnly, strTitle
  End If
End Sub

Public Sub ExportPicture(strPT As String, strDateTime As String)
      With Me
        .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 & "_" & strDateTime & "_" & .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

0
 

Author Comment

by:fjjlee
ID: 40379174
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.
0
 

Author Comment

by:fjjlee
ID: 40379188
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...
0
 

Author Comment

by:fjjlee
ID: 40386345
Thanks for all your help.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now