Dlog11
07-26-2019, 05:22 PM
I am having an issue with macro assigned shapes.
I have created a sign in board that people use to let us know when they are in or out of the building. I have assigned each person a transparent shape that is covering their name, job title, and status. I have named the shape based on which row the person is assigned in another sheet, then use formulas to show their name in the main sheet.
Here is the problem. This worked fantastic in windows 7 and excel 2010, but has gained a lag when upgrading to windows 10 and excel 2016. Now when people try to sign in or out, they are getting frustrated with how long it takes to sign in or out.
I tried to re-build the workbook and started noticing the lag when adding all the shapes into the sheet. Is there a new function in regards to shapes? And Can I turn it off or create a workaround.
Thing I have tried:
-Disabling auto save
-Disabling auto calculations
-Turning off screen updating
-Reducing code complexity
-Eliminating all formulas
-Removing userforms
It all seems to keep coming back to the shapes. I think there are roughly 130 shapes.. any help would be greatly appreciated as I have a headache trying to solve this lol
Sub Definition()
Application.ScreenUpdating = False
IDcell = "'Info Board'!C" & Num
JOBgroup = "'Info Board'!B" & Num
NAMEgroup = "'Info Board'!A" & Num
NoteCell(1) = "'Info Board'!D" & Num
NoteCell(2) = "'Info Board'!F" & Num
NoteCell(3) = "'Info Board'!H" & Num
FCell(1) = "'Info Board'!C" & Num
FCell(2) = "'Info Board'!E" & Num
FCell(3) = "'Info Board'!G" & Num
EvalRange = "'In-Out'!A51"
PicRange = "Pic" & Num
Application.ScreenUpdating = True
End Sub
‘__________________________________________________________________________ __________
Sub Stat_Click()
'finds the name of the shape, which I have named based
'on the row the individual is located on the sepreate sheet.
Num = ActiveSheet.Shapes(Application.Caller).Name
Call Definition
'Changes the individuals status from or to IN or OUT
If Range(EvalRange) = 1 Then
If Range(IDcell).Value <> "IN" Then
Range(IDcell).Value = "IN"
Else
Range(IDcell).Value = "OUT"
End If
'looks through cells that I have used to leave messages for people
'to see if the individual that is signing in/out has a message.
Dim i As Integer
For i = 1 To 3
If Range(NoteCell(i)).Value <> "" Then
ActiveSheet.Shapes.Range(Array("MessagePic")).Visible = msoTrue
MsgBox Range(NoteCell(i)).Value, , "From " & Range(FCell(i)).Value
ActiveSheet.Shapes.Range(Array("MessagePic")).Visible = msoFalse
Range(NoteCell(i)).Value = ""
Range(FCell(i)).Value = ""
End If
Next i
'Ensure that the sheet looks right on the page
Application.ScreenUpdating = False
Calculate
ActiveWindow.SmallScroll UP:=100
Call Show
Call FullScreen
Range("A52").Select
Application.ScreenUpdating = True
End If
'Ive setup some admin tools so that we can change names and pictures easily. I am aware that
'I should use a variable, but was unsure about the longevity of declared variables at the time.
If Range(EvalRange) = 2 Then AdminSettings.Show
End Sub
I have created a sign in board that people use to let us know when they are in or out of the building. I have assigned each person a transparent shape that is covering their name, job title, and status. I have named the shape based on which row the person is assigned in another sheet, then use formulas to show their name in the main sheet.
Here is the problem. This worked fantastic in windows 7 and excel 2010, but has gained a lag when upgrading to windows 10 and excel 2016. Now when people try to sign in or out, they are getting frustrated with how long it takes to sign in or out.
I tried to re-build the workbook and started noticing the lag when adding all the shapes into the sheet. Is there a new function in regards to shapes? And Can I turn it off or create a workaround.
Thing I have tried:
-Disabling auto save
-Disabling auto calculations
-Turning off screen updating
-Reducing code complexity
-Eliminating all formulas
-Removing userforms
It all seems to keep coming back to the shapes. I think there are roughly 130 shapes.. any help would be greatly appreciated as I have a headache trying to solve this lol
Sub Definition()
Application.ScreenUpdating = False
IDcell = "'Info Board'!C" & Num
JOBgroup = "'Info Board'!B" & Num
NAMEgroup = "'Info Board'!A" & Num
NoteCell(1) = "'Info Board'!D" & Num
NoteCell(2) = "'Info Board'!F" & Num
NoteCell(3) = "'Info Board'!H" & Num
FCell(1) = "'Info Board'!C" & Num
FCell(2) = "'Info Board'!E" & Num
FCell(3) = "'Info Board'!G" & Num
EvalRange = "'In-Out'!A51"
PicRange = "Pic" & Num
Application.ScreenUpdating = True
End Sub
‘__________________________________________________________________________ __________
Sub Stat_Click()
'finds the name of the shape, which I have named based
'on the row the individual is located on the sepreate sheet.
Num = ActiveSheet.Shapes(Application.Caller).Name
Call Definition
'Changes the individuals status from or to IN or OUT
If Range(EvalRange) = 1 Then
If Range(IDcell).Value <> "IN" Then
Range(IDcell).Value = "IN"
Else
Range(IDcell).Value = "OUT"
End If
'looks through cells that I have used to leave messages for people
'to see if the individual that is signing in/out has a message.
Dim i As Integer
For i = 1 To 3
If Range(NoteCell(i)).Value <> "" Then
ActiveSheet.Shapes.Range(Array("MessagePic")).Visible = msoTrue
MsgBox Range(NoteCell(i)).Value, , "From " & Range(FCell(i)).Value
ActiveSheet.Shapes.Range(Array("MessagePic")).Visible = msoFalse
Range(NoteCell(i)).Value = ""
Range(FCell(i)).Value = ""
End If
Next i
'Ensure that the sheet looks right on the page
Application.ScreenUpdating = False
Calculate
ActiveWindow.SmallScroll UP:=100
Call Show
Call FullScreen
Range("A52").Select
Application.ScreenUpdating = True
End If
'Ive setup some admin tools so that we can change names and pictures easily. I am aware that
'I should use a variable, but was unsure about the longevity of declared variables at the time.
If Range(EvalRange) = 2 Then AdminSettings.Show
End Sub