I have a sheet in excel that list products and a picture for each product (Column D). I have put the following code in the worksheet but my problem is this.
Problem: If a user clicks on a product image and then clicks on another image before clicking on a 2nd time to make the image small again the 2nd clicked image disappears and the 1st image adjusted to the new size and will only enlarge even bigger.
Image:
Screenshot Steps of what is happening
Option Explicit
Dim fd As Boolean
Sub PicPopUp_Click()
fd = fd Xor True
With ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
If fd Then
.Left = .Left - 50
.Width = .Width + 50
.Top = .Top - 50
.Height = .Height + 50
Else
.Left = .Left + 50
.Width = .Width - 50
.Top = .Top + 50
.Height = .Height - 50
End If
.ShapeRange.ZOrder msoBringToFront
End With
End Sub
I'm not familair enough with your code.. But would it be possible to reset column D on every click on that column? I'm assuming that all the images are a standard size.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
MsgBox "Nice Work!" 'place reset image size code here.
Call "whatever your image resize macro is named"
End If
End Sub
Related
I have created a Gantt chart that sits directly next to the row the data is pulled from so everything is in one neat line. There are several months of data, so I have created two buttons (Next Page/Previous Page) that add/subtract 30 from the minimum and maximum values of the x-axis. Because everything is lined up Gantt-table-style, I have been trying to reset the chart's location to it's original one. Unfortunately, the chart still moves creating a small gap between the chart and my data. Any advice is greatly appreciated!
None of my charts corners lay on the corner of a cell, plus some columns may be re sized later on.
Private Sub NEXT_PG_Click()
Dim chart_height As Single, chart_length As Single, chart_top As Single, chart_left As Single
'Saving original position to save later
With ActiveSheet.ChartObjects("Chart 2")
chart_height = .Height
chart_width = .Width
chart_top = .Top
chart_left = .Left
End With
'Displaying next 30 days of data
With ActiveSheet.ChartObjects("Chart 2").Chart.Axes(xlValue)
.MinimumScale = .MinimumScale + 30
.MaximumScale = .MaximumScale + 30
End With
'Trying to set original location and size
With ActiveSheet.ChartObjects("Chart 2")
.Height = chart_height
.Width = chart_width
.Left = chart_left
.Top = chart_top
End With
End Sub
Added images
Update: As a temporary fix, I have tried to set the location of the plot area to a specific location, but this makes it worse. Please see the change to the attempted with statement below:
With ActiveSheet.ChartObjects("Chart 2").Chart.PlotArea
.Height = Range("A8:A30").Height
.Width = Range("J6:U6").Width
.Top = Range("J8").Top
.Left = Range("J8").Left
End With
I have a PowerPoint 2013 presentation. On the first slide I have 15 images. A mouse click on the image changes a variable in the VBA macro, but it does not look like the image has been clicked on by the user so it might be confusing if they clicked it or not.
I want to alter that image that they clicked to show it was clicked. I don't care if its a highlight or shadow or the image changes.
Sub Resize()
With ActiveWindow.Selection.ShapeRange
.Height = 2.78 * 72
.Width = 4.17 * 72
.Left = 0.78 * 72
.Top = 1.25 * 72
.ZOrder msoSendToBack
End With
End Sub
Sub DefButton1Clicked()
Element1 = 1
Resize
End Sub
this does not work.
Ok I have figured this out here is what I did:
Sub DefButton1Clicked(oSH As Shape)
Element1 = 1
MsgBox oSH.Name
oSH.Shadow.Type = msoShadow17
oSH.Shadow.ForeColor.RGB = RGB(0, 0, 128)
oSH.Shadow.OffsetX = 3
oSH.Shadow.OffsetY = 2
End Sub
I was also able to reset the other button once the one button was clicked by doing this:
Dim oImg1 As Shape
Set oImg1 = ActivePresentation.Slides(1).Shapes.Item("Picture 7")
oImg1.Shadow.Visible = msoFalse
Dim oImg2 As Shape
Set oImg2 = ActivePresentation.Slides(1).Shapes.Item("Picture 8")
oImg2.Shadow.Visible = msoFalse
Community wiki. Answer is in the question. Anyone finding this topic in a search will see there is an answer and is more likely to look in for a hopefully useful answer.
Ok I have figured this out here is what I did:
Sub DefButton1Clicked(oSH As Shape)
Element1 = 1
MsgBox oSH.Name
oSH.Shadow.Type = msoShadow17
oSH.Shadow.ForeColor.RGB = RGB(0, 0, 128)
oSH.Shadow.OffsetX = 3
oSH.Shadow.OffsetY = 2
End Sub
I was also able to reset the other button once the one button was clicked by doing this:
Dim oImg1 As Shape
Set oImg1 = ActivePresentation.Slides(1).Shapes.Item("Picture 7")
oImg1.Shadow.Visible = msoFalse
Dim oImg2 As Shape
Set oImg2 = ActivePresentation.Slides(1).Shapes.Item("Picture 8")
oImg2.Shadow.Visible = msoFalse
I looked around. All I was able to find was resizing in Excel or through Excel.
I am pasting a picture from pdf and need one click resizing and positioning.
I finally got it .. Here is what I did, just in case someone is facing same problem.
This re-sizes the image, sets it in the desired position and sends it to the back.
Sub Resize()
With ActiveWindow.Selection.ShapeRange
.Height = 2.78 * 72 //72 is the multiplier for the inch
.Width = 4.17 * 72
.Left = 0.78 * 72
.Top = 1.25 * 72
.ZOrder msoSendToBack // This sends picture to the back
End With
End Sub
Thanks for the code. I wanted to be able to automatically resize a bunch of screenshots to fit the size of a slide. I'm guessing other people might need to do this too, so I'm posting what I did.
First, in PowerPoint 2010 in Page Setup, I set the slides to be 16:9 to match the proportions of my monitor/screenshots. Then I added a blank slide and pasted the image for each screenshot. I then ran this code:
Sub ResizeAll()
For each tSlide in ActiveWindow.Presentation.Slides
tSlide.Select
With tSlide.Shapes.Item(1) 'assume a blank slide with one image added only
.Select
.Height = ActiveWindow.Presentation.PageSetup.SlideHeight
.Width = ActiveWindow.Presentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With
Next
End Sub
code to fit an image in a slide (change the height and width as per requirement) :
pptSlide.Shapes(1).Height = 850: pptSlide.Shapes(1).Width = 650
I'm working on a Userform in Excel that has to be dynamically generated each time. It can list many (100+) lines which are all exactly the same in format. These are generated by the following code snippet.
' ctextbox
Set ctl = .Controls.Add("Forms.Textbox.1")
With ctl
.Top = 12 + linetop
.Left = 464.9
.Width = 140
.Height = 18
.Name = FieldName & "_ctextbox"
End With
' cshow
Set ctl = .Controls.Add("Forms.CommandButton.1")
With ctl
.Top = 13.1 + linetop
.Left = 611.35
.Width = 41.95
.Height = 18
.Name = FieldName & "_cshow"
.Caption = "Show All"
End With
' confirm
Set ctl = .Controls.Add("Forms.Checkbox.1")
With ctl
.Top = 13.5 + linetop
.Left = 659
.Width = 44.95
.Height = 17.25
.Name = FieldName & "_confirm"
.Caption = "Confirm"
End With
It would fine except for a random occurrence where the Confirm checkbox appears smaller than the rest. The screenshot below shows what I mean.
Has anyone experienced this issue before?
I would recommend using repainting the Userform after you have added the controls dynamically.
The Repaint method completes any pending screen updates for a specified form. When performed on a form, the Repaint method also completes any pending recalculations of the form's controls.
This method is useful if the contents or appearance of an object changes and you don't want to wait until the system automatically repaints the area. Me.Repaint simply updates the display by redrawing the form
I had the same issue in that my repaint did not work. I solved this by setting the CheckBox AutoSize property to True and I have no problems anymore.
I'm running into an unusual problem. I have an application with a multipage that contains about 10 pages and every page contains another multipage with 3-5 pages. The problem was that the app was too "heavy" and I wanted to break it into multiple forms (a form for every page).
In the initial app the form had as I said about 10 pages, with another 3-5 pages on every one of them and on every page there were about 3-20 comboboxes, 4-40 textboxes. All of them were loaded at initialization by executing a piece of code.
Now... I copied the piece of code for every page and added it in the initializations of the form that replaced it.
The code is something like this:
Private Sub UserForm_Initialize()
Dim i As Integer
Dim ws1 As Worksheet
Dim pagini As range
Set ws1 = Worksheets("Config")
Dim cControl As Control
Set cControl = Me.Controls.Add("Forms.Multipage.1", "oly", True)
With cControl
.Width = 650
.Height = 380
.Top = 0
.Left = 0
End With
Me.Controls("oly").Pages.Remove (Page1)
Me.Controls("oly").Pages.Remove (Page2)
For Each pagini In ws1.range("pagoly")
Me.Controls("oly").Pages.Add (pagini)
Next pagini
i = 0
Do While i < 5
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "iooly" & i, True)
With cControl
.Caption = "IO"
.Width = 210
.Height = 340
.Top = 2
.Left = 5
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "niooly" & i, True)
With cControl
.Caption = "nIO"
.Width = 210
.Height = 340
.Top = 2
.Left = 220
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "descriere" & i, True)
With cControl
.Caption = "Descriere"
.Width = 210
.Height = 340
.Top = 2
.Left = 435
End With
Loop
End Sub
So far it just adds the frames on every of the 5 pages of this form. The problem is that I get the "There is insufficient memory available to complete this operation" when I want to run it and I really don't know why. Yet on the previous version which loaded 50 times more stuff there was no problem. Do you have any idea where's the problem because I really don't understand it.
You have
Do While i < 5
'stuff
Loop
and I don't see where i changes value so that the program will exit the loop. Am I missing something?