VBA Excel copy picture in Image ctrol to another Image ctrol in different userform

Discussion in 'Programmer's Corner' started by atferrari, Nov 24, 2013.

  1. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    VBA Excel
    Two UserForms:

    a) LayerAndFrameSettings with several Image controls. Amongst them: LED_1, LED_2, LED3, LED_4
    b) Luminosity with five Image controls: Level_1, Level_2, Level_3, Level_4, Level_5

    All data (single variables / arrays) is declared As Byte, enough for the values in play.

    Code, based on external values is expected to copy the picture in one of the image controls at Luminosity
    to one of the LED_X Image controls at LayerAndFrameSettings userform.

    After extensive testing found that:

    The following sentences do it properly
    Code ( (Unknown Language)):
    1.  
    2.     LayerAndFrameSettings.Controls("LED_4").Picture =  Luminosity.Controls("Level_" &  CStr(LayerLuminosityData(Pntr_LED))).Picture
    3.     LayerAndFrameSettings.Controls("LED_2").Picture = Luminosity.Level_4.Picture
    4.     LayerAndFrameSettings.Controls("Middle_square_change").Picture =  Luminosity.Controls("Level_" &  CStr(LayerLuminosityData(Pntr_LED))).Picture
    5.     LayerAndFrameSettings.Controls("Inner_square_change").Picture = Luminosity.Controls("Level_4").Picture
    6.     LayerAndFrameSettings.Controls("Middle_" &  "square_change").Picture = Luminosity.Controls("Level_" &  CStr(LayerLuminosityData(Pntr_LED))).Picture
    7.     LayerAndFrameSettings.Controls("Inner_square_change").Picture = Luminosity.Controls("Level_4").Picture
    8.     LayerAndFrameSettings.LED_3.Picture = Luminosity.Controls("Level_" & CStr(LayerLuminosityData(Pntr_LED))).Picture
    9.  
    BUT the following do not copy any picture at all and Excel does NOT raise any error at runtime
    Code ( (Unknown Language)):
    1.  
    2.     LayerAndFrameSettings.Controls("LED_" & CStr(Pntr_LED)).Picture = Luminosity.Level_2.Picture
    3.     LayerAndFrameSettings.Controls("LED_" & CStr(Pntr_LED)).Picture =  Luminosity.Controls("Level_" &  CStr(LayerLuminosityData(Pntr_LED))).Picture
    4.  
    Just in case I checked in the worksheet, the values below and they display OK
    Code ( (Unknown Language)):
    1.  
    2.     Range("FY4").Value = "LED_" & CStr(Pntr_LED)
    3.     Range("GB4").Value = "Level_" & CStr(LayerLuminosityData(Pntr_LED))
    4.     Range("GD4").Value = LayerLuminosityData(Pntr_LED)
    5.  
    I am supposed to use a string to identify which control is receiving the picture, right?
     
  2. panic mode

    Senior Member

    Oct 10, 2011
    1,318
    304
    post your file
     
  3. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    It is definitely long.

    Will try to reduce it to the necessary minimum.

    Thanks.
     
  4. panic mode

    Senior Member

    Oct 10, 2011
    1,318
    304
    i really don't understand why would anyone use such long lines of code. how do you even troubleshoot something like that? no wonder it is challenging to work with it, it does not even fit on screen one has to scroll or use line wrap just to see it. for example:
    Code ( (Unknown Language)):
    1. LayerAndFrameSettings.Controls("Middle_" &  "square_change").Picture = Luminosity.Controls("Level_" &  CStr(LayerLuminosityData(Pntr_LED))).Picture
    i strongly prefer making an arsenal of subs and functions (can be in separate module). I define and debug them once and then use them everywhere in my actual code. that makes life much easier and code is shorter, cleaner, easier to understand, troubleshoot, maintain... also it is a pleasure to test or manipulate in intermediate window.

    if all you want is to set brightness of an LED, why not use something cute and short like:

    Code ( (Unknown Language)):
    1. Call SetLed("LED13", 3)
     
    atferrari likes this.
  5. panic mode

    Senior Member

    Oct 10, 2011
    1,318
    304
    here is a little demo i came up with in i few minutes
     
    atferrari likes this.
  6. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    Hola Panic, just in case note that I changed the current names of the Image controls to "LED4", "LED5", "LED6" and so on.

    In Módulo1

    Code ( (Unknown Language)):
    1.  
    2.  
    3. Option Explicit
    4.  
    5.     Public j As Object
    6.     Public Pntr_layer As Byte
    7.     Public Pntr_row As Byte
    8.    
    9.     Public LayerLuminosityData(1 To 49) As Byte
    10.     Public OffsetColFmActive(1 To 49) As Double
    11.     Public OffsetRowFmActive(1 To 49) As Byte
    12.    
    13.     Public Ctrl_pressed As Boolean
    14.    
    15.     Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    16.     Const VK_CONTROL As Integer = &H11 'Ctrl
    17.  
    18.  
    19. 'THIS Sub WORKS FLAWLESSLY ALL THE TIME
    20.  
    21.        
    22. Public Sub Transfer_layer_data_to_userform()
    23.     Dim Pntr_LED As Byte
    24.    
    25.     For Pntr_LED = 1 To 49
    26.         LayerLuminosityData(Pntr_LED) = ActiveCell.Offset(rowOffset:=OffsetRowFmActive(Pntr_LED), columnOffset:=OffsetColFmActive(Pntr_LED)).Value
    27.        
    28.         With LayerAndFrameSettings
    29.             Select Case LayerLuminosityData(Pntr_LED)
    30.                 Case Is = 0
    31.                     .Controls("LED" & CStr(Pntr_LED)).Picture = Luminosity.Level_0.Picture
    32.                 Case Is = 1
    33.                     .Controls("LED" & CStr(Pntr_LED)).Picture = Luminosity.Level_1.Picture
    34.                 Case Is = 2
    35.                     .Controls("LED" & CStr(Pntr_LED)).Picture = Luminosity.Level_2.Picture
    36.                 Case Is = 3
    37.                     .Controls("LED" & CStr(Pntr_LED)).Picture = Luminosity.Level_3.Picture
    38.                 Case Is = 4
    39.                     .Controls("LED" & CStr(Pntr_LED)).Picture = Luminosity.Level_4.Picture
    40.             End Select
    41.         End With
    42.     Next Pntr_LED
    43. End Sub
    44.  
    In LayerAndFrameSettings code module there are:

    49 Calls like these below (three shown)

    Code ( (Unknown Language)):
    1.  
    2. Sub LED4_Click()
    3.     Call Process_click_on_LED_image(4)
    4. End Sub
    5.  
    6. Sub LED5_Click()
    7.     Call Process_click_on_LED_image(5)
    8. End Sub
    9.  
    10. Sub LED6_Click()
    11.     Call Process_click_on_LED_image(6)
    12. End Sub
    13.  
    calling this Sub (where the "offending line" is the very last).


    Code ( (Unknown Language)):
    1.  
    2.  
    3. Public Sub Process_click_on_LED_image(Pntr_LED As Byte)
    4.     Dim TargetCell As Object
    5.    
    6.     Call TestCTRLkey
    7.    
    8.     If Ctrl_pressed = True Then
    9.         If LayerLuminosityData(Pntr_LED) > 0 Then
    10.             LayerLuminosityData(Pntr_LED) = LayerLuminosityData(Pntr_LED) - 1
    11.         End If
    12.     Else
    13.         If LayerLuminosityData(Pntr_LED) < 4 Then
    14.             LayerLuminosityData(Pntr_LED) = LayerLuminosityData(Pntr_LED) + 1
    15.         End If
    16.     End If
    17.    
    18.     Set TargetCell = ActiveCell.Offset(OffsetRowFmActive(Pntr_LED), OffsetColFmActive(Pntr_LED))
    19.     TargetCell.Value = LayerLuminosityData(Pntr_LED)
    20.        
    21.     Select Case TargetCell.Value
    22.         Case Is = 0
    23.             TargetCell.Interior.Color = RGB(202, 202, 202)
    24.         Case Is = 1
    25.             TargetCell.Interior.Color = RGB(67, 199, 130)
    26.         Case Is = 2
    27.             TargetCell.Interior.Color = RGB(110, 210, 210)
    28.         Case Is = 3
    29.             TargetCell.Interior.Color = RGB(179, 231, 216)
    30.         Case Is = 4
    31.             TargetCell.Interior.Color = RGB(170, 244, 250)
    32.     End Select
    33.    
    34.     Call Update_single_LED_data_in_block(Pntr_LED)
    35.    
    36.     'Tres datos a ser mostrados en la hoja
    37.    
    38.     Range("FY4").Value = "LED" & CStr(Pntr_LED)
    39.     Range("GB4").Value = "Level_" & CStr(LayerLuminosityData(Pntr_LED))
    40.     Range("GD4").Value = LayerLuminosityData(Pntr_LED)
    41.    
    42.     LayerAndFrameSettings.Controls("LED" + CStr(Pntr_LED)).Picture = Luminosity.Controls("Level_" & CStr(LayerLuminosityData(Pntr_LED))).Picture
    43.  End Sub
    44.  
     
  7. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    I added an extra Image control (LED410) and the line in bold.
    Code ( (Unknown Language)):
    1.     [B]LayerAndFrameSettings.LED410.Picture = Luminosity.Controls("Level_" & CStr(LayerLumiData(Pntr_LED))).Picture[/B]
    2.     LayerAndFrameSettings.Controls("LED" & CStr(Pntr_LED)).Picture = LayerAndFrameSettings.LED410.Picture
    3.  
    The desired picture gets copied to LED410 but not the the desired destination.
    Now I can say that what fails is in the last line.
     
  8. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    I replaced Image controls with Label controls. Works like a charm.

    Wish I could say why the other way did not work.
     
  9. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    Your words Panic. I understand my code and along the years I can revisit old one with little difficulties.

    I feel at ease with long variable names if they are descriptive. Find them helpful.

    Later when code was tested I shorten them within reason (but not much).

    This guy probably could not team up with you, methinks:

    Code ( (Unknown Language)):
    1. Private Sub ConnectionApp_WorkbookPivotTableOpenConnection(ByVal wbOne As Workbook, Target As PivotTable)
    2.  
    3. xlCommandUnderlinesAutomatic
    4.  
    5. xlTickLabelOrientationDownward
    6.  
    7. xlXmlImportElementsTruncated
    8.  
    9.  
    :D
     
  10. panic mode

    Senior Member

    Oct 10, 2011
    1,318
    304
    the most important thing is you solved it.

    i guess you can call my preferences ... unique. :D
     
  11. atferrari

    Thread Starter AAC Fanatic!

    Jan 6, 2004
    2,644
    759
    Hola Panic,

    I've been criticized for that before but as I do it consistently is not a real problem to me. Being honest, I came to suspect that your criteria is the prevailing one everywhere.

    I know I solved it but still do not know why it was not working. Could it be any particular setting of those Image controls? I run through them many times but nothing seems related to my problem.

    I am not experient in VBA besides this intensive last two months where I learnt a LOT (with a much BIGGER LOT still to be discovered and learnt :p).
    Gracias again for your help (and the time spent in replying).
     
Loading...