none
PHOTO QUALITY IN EXCEL DAMAGED. RRS feed

  • Question

  • Hi,

    I used this code in excel

    Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim LastRow As Long, c As Range
        Dim LastCol As Long, MYRange As Range
        Dim v As Variant, GetMeOut As Label
        Application.PrintCommunication = False
        Application.ScreenUpdating = False
        LastRow = Cells(Cells.Rows.Count, "B").End(xlUp).ROW
        Set MYRange = Range("B2:B" & LastRow)
        For Each c In MYRange
        If c.Value = "" Then GoTo GetMeOut
        v = Split(c.Value, " ")
        If Not IsError(Application.Match("-", v, 0)) Then
        LastCol = ActiveSheet.Cells(c.ROW, Columns.Count).End(xlToLeft).Column
        Set MYRange = c.Offset(, -1).Resize(, LastCol)
        End If
        Next
        With MYRange
        With ActiveSheet
       .Rows.AutoFit
       .Columns.AutoFit
        Selection.RowHeight = 372
    GetMeOut:
        End With
        End With
        Application.PrintCommunication = True
        Application.ScreenUpdating = True
    End Sub

    Simple version of this code did no harm but did job improperly. This code changed Photo quality from this,

    Saturday, July 11, 2015 4:54 AM

All replies

  • Saturday, July 11, 2015 4:56 AM
  • To this one. Can someone please help me ?

    I do not want row 1 to change it's width and height. Can we fix it permanently. Can stop selecting photo every time we click it ?

    regards.


    Saturday, July 11, 2015 4:57 AM
  • You say you don't want row 1 to change it's height and I assume you mean you don't want the column the photo is in to change its width. But apart from not wanting to change the ratio of the picture's dimensions you don't say what you do want to do and without seeing your sheet it's hard to understand what your code is sizing to.

    However the main thing I suspect you need to do is ensure the picture's placement property is set to xlMove or possibly xlFreeFloating, but not xlMoveAndSize. Manually, right click the picture, Size and Properties, Properties, Move but don't size with cells.

    Rather than sizing the picture to cells you may want to size cells to the picture, or largest pictures in rows and/or columns.

    Saturday, July 11, 2015 10:51 AM
    Moderator
  • Hi,

    Thank you Peter Thornton,

    I do not want change in row 1, because It has headings. Presently it changes with cell selection in that row.

    I want to make a big collection of photos in a column and name, other details in other columns. I want a row collapse in to normal size along with photo. In this way it is easy to see other rows. When mouse click there they elongate in height and photo can be seen. And so on to next photo.

    This problem Occurred few after many trials. It does not damaged photo in one attempt. There may be some thing wrong in code. I am a layman in this. please help.

    regards 

    Saturday, July 11, 2015 1:59 PM
  • HI,

    I have made a test to try to reproduce your issue, when the selection changed, the column width for the photo changed while my picture has been set move and size with cells.

    >>I do not want row 1 to change it's width and height

    but in the code you provided, you have reset the width and height by the code

     With ActiveSheet
        .Rows.AutoFit
        .Columns.AutoFit

    you may try to commet the dode.

    Hope this could help you, if it helps less, could you please share the sample workbook to narrow down this issue?

    Best Regards,

    Lan


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, July 13, 2015 9:26 AM
    Moderator
  • Hi,

    Thank you for reply.

    yes I used this.

        With MYRange
        With ActiveSheet
       .Rows.AutoFit
       .Columns.AutoFit
        Selection.RowHeight = 372

    If I use only MYRange, it does not work. When I use with active sheet, it works for entire sheet. how to save row1 from this Autofit ? This is problem I want solution for. And secondly the problem created with photo. which happens only once in many trials of cell size reduction and increase.

    Monday, July 13, 2015 4:22 PM
  • Hi,

    >>to save row1 from this Autofit ?

    you may reset the row height for the first row.

     ActiveSheet.Rows(1).RowHeight = 40 

    >>And secondly the problem created with photo. which happens only once in many trials of cell size reduction and increase

    HI have tried many times, and couldn't reproduce your issue,How do you set the size and properties fot the picture,   I will suggest you follow peter's advice to examine the  picture's placement property  , or you could also try to fix the column with for the picture.

    By the way,what's your Excel version ? Have you updated it to the latest version, Is there any add-in for your Excel application ?

    Best Regards,

    Lan


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, July 14, 2015 8:18 AM
    Moderator
  • Hi,

    I did now this Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim LastRow As Long, c As Range
        Dim LastCol As Long, MYRange As Range
        Dim v As Variant, GetMeOut As Label
        Application.ScreenUpdating = False
        LastRow = Cells(Cells.Rows.Count, "B").End(xlUp).ROW
        Set MYRange = Range("B2:B" & LastRow)
        For Each c In MYRange
        If c.Value = "" Then GoTo GetMeOut
        v = Split(c.Value, " ")
        If Not IsError(Application.Match("-", v, 0)) Then
        LastCol = ActiveSheet.Cells(c.ROW, Columns.Count).End(xlToLeft).Column
        Set MYRange = c.Offset(, -1).Resize(, LastCol)
        End If
        Next
        With MYRange
        With ActiveSheet
        .Rows(1).RowHeight = 15
       .Rows.AutoFit
       .Columns.AutoFit
       If Selection.ROW >= 2 Then
        Selection.RowHeight = 375
        Else: Exit Sub
        End If
    GetMeOut:
        End With
        End With
        Application.ScreenUpdating = True
    End Sub  working better. any other better way please.

    Tuesday, July 14, 2015 3:24 PM