I dont know when this stopped working to be frank but not long switched to using Office 2016. Either way now a VBA event that previously was firing is not now doing so. At least it does not stop at the first position in the sub where I can set a breakpoint.
There is no use of EnableEvents in this project or other open project, and where the event previously fired, the process reformatting the active cell and another, now it does nothing.
Any help most appreciated!
Public Sub Worksheet_Change(ByVal Target As Range)
Const STATUSCOL1 = "L"
Const STATUSCOL2 = "M"
Const STATUSCOL3 = "N"
Const STATUSCOL4 = "O"
Const STATUSCOL5 = "P"
Const STATUSCOL6 = "Q"
Const STATUSCOL7 = "R"
Const STATUSCOL8 = "S"
Const ACTIONCOL1 = "NOT IMPLEMENTED"
Dim Cell As Range
Dim ac As String
Dim rgtCellVal As Integer
Set Cell = Target
ac = Split(Cell.Address, "$")(1) 'For Column Letter
'if any changes at all mark colum J in Green
If Target.Cells.Count = 1 Then
'If Cell <> IIf(vOldData = vbNullString, "(Null)", vOldData) Then
If Cell.Value <> vOldData Then
Select Case ac
Case ACTIONCOL1
Cells(Cell.Row, Range("J" & 1).Column).Interior.ColorIndex = 42 'Aqua
Case Else
Cells(Cell.Row, Range("J" & 1).Column).Interior.ColorIndex = 4 'bright green
End Select
End If
End If
'Status
'---------------------------------------------------------------------------------------------------------
'Installed & Active
'I&A with Bugs
'Compromise
'If Required
'NotActivatedOrUsed
'UserBlogUseOnly
'UpdateHold
'------------------------------------------
'Deactivated
'Depricated
'Removed
'Not Installed
'------------------------------------------
'Failed
'Broken but activated
'Broken and deactivated
'------------------------------------------
'Status in question
'Ignore
'N.A.
'Not Actionable
'In Progress
'Review
'ConsiderNew
If ac = STATUSCOL1 Or ac = STATUSCOL2 Or ac = STATUSCOL3 Or ac = STATUSCOL4 Or ac = STATUSCOL5 Or ac = STATUSCOL6 Or ac = STATUSCOL7 Or ac = STATUSCOL8 Then
Select Case Cell
Case ""
Cell.Interior.ColorIndex = xlColorIndexNone 'none
Case "Installed & Active"
Cell.Interior.ColorIndex = 43 'Lime
Case "I&A with Bugs"
Cell.Interior.ColorIndex = 36 'Light Yellow
Case "Compromise"
Cell.Interior.ColorIndex = 35 'Light Green
Case "If Required"
Cell.Interior.ColorIndex = 15 'Grey - 25%
Case "UserBlogUseOnly"
Cell.Interior.ColorIndex = 15 'Grey - 25%
Case "UpdateHold"
Cell.Interior.ColorIndex = 46 'Orange
'------------------------------------------
Case "NotActivatedOrUsed"
Cell.Interior.ColorIndex = 15 'Grey - 25%
Case "Deactivated"
Cell.Interior.ColorIndex = 15 'Grey - 25%
Case "Depricated"
Cell.Interior.ColorIndex = 37 'pale blue
Case "Removed"
Cell.Interior.ColorIndex = 41 'Light blue
Case "Rejected"
Cell.Interior.ColorIndex = 41 'Light blue
Case "Not Installed"
Cell.Interior.ColorIndex = 37 'pale blue
'------------------------------------------
Case "Failed"
Cell.Interior.ColorIndex = 3 'Red
Case "Broken"
Cell.Interior.ColorIndex = 3 'Red
Case "BrokenButDeactivated"
Cell.Interior.ColorIndex = 37 'pale blue
'------------------------------------------
Case "StatusInQuestion"
Cell.Interior.ColorIndex = 44 'Gold
Case "Ignore"
Cell.Interior.ColorIndex = xlColorIndexNone 'none
Case "N.A."
Cell.Interior.ColorIndex = xlColorIndexNone 'none
Case "Not Actionable"
Cell.Interior.ColorIndex = xlColorIndexNone 'none
Case "In Progress"
Cell.Interior.ColorIndex = 15 'Grey - 25%
Case "Review"
Cell.Interior.ColorIndex = 33 'Sky Blue
Case "ConsiderAlt"
Cell.Interior.ColorIndex = 44 'Gold
Case "------------------------------------------"
Cell.Interior.ColorIndex = xlColorIndexNone 'none
Case Else
Cell.Interior.ColorIndex = 40 'Tan
rgtCellVal = Cell.Offset(0, 1).Interior.ColorIndex
If (Cell = "") And rgtCellVal = 15 Then
Cell.Interior.ColorIndex = 15
End If
End Select
End If
End Sub
I don't have Excel 2016 yet, but in 2007-2013 you can check macro setting under
File --> Options --> Trust Center --> Trust Center Settings... --> Macro Settings
Make sure that Disable all macros with notification or better is selected
If it was an Add-In, I'd say check to the disabled Add-In's, but it doesn't look like one.
Where is the file located? If it's on a network drive does it work when you copy it to a local drive?
If so then, the check the Trusted Documents options under the Trust Center Settings...
Ok I have the answer:
Trust Center. Macro Settings tab. Developer Macro Settings section. Trust Access to the VBA project object model. Tick Yes!
Related
I'm trying to upload a .hex file via Uart into an ATxmega32a4. I'm using BASCOM IDE and Programmed my MCU with the sample code which is available in sample folder of Bascom (I have attached my code). So I'm using MSC Bootloader Wizard in Bascom to upload my code but unfortunately it has error 6006. I increased timeout but the problem is not fixed.
I monitored serial port as you can find it in attachments.
Could anyone help?
'----------------------------------------------------------------
' (c) 1995-2020, MCS
' BootloaderXmega32A4.bas
' This sample demonstrates how you can write your own bootloader
' in BASCOM BASIC for the XMEGA
'-----------------------------------------------------------------
'The loader is supported from the IDE
$crystal = 29491200 ' xmega128 is running on 32 MHz
$regfile = "xm32a4def.dat"
$hwstack = 40
$swstack = 40
$framesize = 40
'first enabled the osc of your choice
''Config Osc = Disabled , 32mhzosc = Enabled 'internal 2 MHz and 32 MHz enabled
Config Osc = Enabled , 32mhzosc = Enabled , Extosc = Enabled
'configure the systemclock
''Config Sysclock = 32mhz , Prescalea = 1 , Prescalebc = 1_1 ' we will use 32 MHz and divide by 1 to end up with 32 MHz
Config Sysclock = External , Prescalea = 1 , Prescalebc = 1_1
$loader = &H4000 ' bootloader starts after the application
'this sample uses 38400 baud. To be able to use the Xplain which has a bootloader working at 9600 baud you need to use 9600 baud
''Config Com1 = 38400 , Mode = Asynchroneous , Parity = None , Stopbits = 1 , Databits = 8 ' use USART C0
'COM0-USARTC0, COM1-USARTC2, COM2-USARTD0. etc.
''Config Portc.3 = Output 'define TX as output
''Config Pinc.2 = Input
Config Com3 = 115200 , Mode = Asynchroneous , Parity = EVEN , Stopbits = 1 , Databits = 8
Open "COM3:" For Binary As #1
Config PortD.3 = Output 'define TX as output
Config PinD.2 = Input
Const Maxwordbit = 7 ' Z7 is maximum bit '
Const Maxword =(2 ^ Maxwordbit) * 2 '128
Const Maxwordshift = Maxwordbit + 1
Const Cdebug = 0 ' leave this to 0
'Dim the used variables
Dim Bstatus As Byte , Bretries As Byte , Bmincount As Byte , Bblock As Byte , Bblocklocal As Byte
Dim Bcsum1 As Byte , Bcsum2 As Byte , Buf(128) As Byte , Csum As Byte
Dim J As Byte , Spmcrval As Byte ' self program command byte value
Dim Z As Long 'this is the Z pointer word
Dim Vl As Byte , Vh As Byte ' these bytes are used for the data values
Dim Wrd As Word , Page As Word 'these vars contain the page and word address
Disable Interrupts 'we do not use ints
'We start with receiving a file. The PC must send this binary file
'some constants used in serial com
Const Nak = &H15
Const Ack = &H06
Const Can = &H18
$timeout = 300000 'we use a timeout
'When you get LOADER errors during the upload, increase the timeout value
'for example at 16 Mhz, use 200000
Bretries = 5 : Bmincount = 3 'we try 10 times and want to get 123 at least 3 times
Do
Bstatus = Waitkey(#1) 'wait for the loader to send a byte
If Bstatus = 123 Then 'did we received value 123 ?
If Bmincount > 0 Then
Decr Bmincount
Else
Print #1, Chr(bstatus);
Goto Loader ' yes so run bootloader
End If
Else 'we received some other data
If Bretries > 0 Then 'retries left?
Bmincount = 3
Decr Bretries
Else
Rampz = 0
Goto Proces_reset 'goto the normal reset vector at address 0
End If
End If
Loop
'this is the loader routine. It is a Xmodem-checksum reception routine
Loader:
Do
Bstatus = Waitkey(#1)
Loop Until Bstatus = 0
Spmcrval = &H20 : Gosub Do_spm ' erase all app pages
Bretries = 10 'number of retries
Do
Csum = 0 'checksum is 0 when we start
Bblocklocal = 1
Print #1, Chr(bstatus); ' firt time send a nack
Do
Bstatus = Waitkey(#1) 'wait for statuse byte
Select Case Bstatus
Case 1: ' start of heading, PC is ready to send
Csum = 1 'checksum is 1
Bblock = Waitkey(#1) : Csum = Csum + Bblock 'get block
Bcsum1 = Waitkey(#1) : Csum = Csum + Bcsum1 'get checksum first byte
For J = 1 To 128 'get 128 bytes
Buf(j) = Waitkey(#1) : Csum = Csum + Buf(j)
Next
Bcsum2 = Waitkey(#1) 'get second checksum byte
If Bblocklocal = Bblock Then 'are the blocks the same?
If Bcsum2 = Csum Then 'is the checksum the same?
Gosub Writepage 'yes go write the page
Print #1, Chr(bstatus); 'acknowledge
Incr Bblocklocal 'increase local block count
Else 'no match so send nak
Print #1, Chr(bstatus);
End If
Else
Print #1, Chr(bstatus); 'blocks do not match
End If
Case 4: ' end of transmission , file is transmitted
If Wrd > 0 Then 'if there was something left in the page
Wrd = 0 'Z pointer needs wrd to be 0
Spmcrval = &H24 : Gosub Do_spm 'write page
End If
Print #1, Chr(bstatus); ' send ack and ready
Waitms 20
Goto Proces_reset
Case &H18: ' PC aborts transmission
Goto Proces_reset ' ready
Case 123 : Exit Do 'was probably still in the buffer
Case 124 : Exit Do
Case Else
Exit Do ' no valid data
End Select
Loop
If Bretries > 0 Then 'attempte left?
Waitms 1000
Decr Bretries 'decrease attempts
Else
Goto Proces_reset 'reset chip
End If
Loop
'write one or more pages
Writepage:
For J = 1 To 128 Step 2 'we write 2 bytes into a page
Vl = Buf(j) : Vh = Buf(j + 1) 'get Low and High bytes
!lds r0, {vl} 'store them into r0 and r1 registers
!lds r1, {vh}
Spmcrval = &H23 : Gosub Do_spm 'write value into page at word address
Wrd = Wrd + 2 ' word address increases with 2 because LS bit of Z is not used
If Wrd = Maxword Then ' page is full
Wrd = 0 'Z pointer needs wrd to be 0
Spmcrval = &H24 : Gosub Do_spm 'write page
Page = Page + 1 'next page
End If
Next
Return
Do_spm:
Z = Page 'make equal to page
Shift Z , Left , Maxwordshift 'shift to proper place
Z = Z + Wrd 'add word
!lds r30,{Z}
!lds r31,{Z+1}
#if _romsize > 65536
!lds r24,{Z+2}
!sts rampz,r24 ' we need to set rampz also for the M128
#endif
Nvm_cmd = Spmcrval
Cpu_ccp = &H9D
!spm 'this is an asm instruction
Do_spm_busy:
!lds r23, NVM_STATUS
!sbrc r23,7 ;if busy bit is cleared skip next instruc tion
!rjmp do_spm_busy
Return
Proces_reset:
Rampz = 0
Goto _reset 'start at address 0
I added a progress bar to my slides with the following code in macros:
Sub ProgressBar()
On Error Resume Next
With ActivePresentation
For X = 1 To .Slides.Count
.Slides(X).Shapes("PB").Delete
Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, _
0, .PageSetup.SlideHeight - 12, _
X * .PageSetup.SlideWidth / .Slides.Count, 12)
s.Fill.ForeColor.RGB = RGB(42, 0, 128)
s.Name = "PB"
Next X:
End With
End Sub
I do not want the progress bar to be 100% at the end of my slides (at my extra slides), but at my "Thank you" slide. Is there a way to do this?
Change this:
For X = 1 To .Slides.Count
to this
For X = 1 To .Slides(42)
But instead of 42, use the number of your thank you slide
Cannot use 'bgcolor' in local scope
my code :
//#version=4
//strategy("try 2", overlay=true)
study("Astrolog 2", "Astrolog 2", overlay=true)
yearStart = 2015
yearEnd = 2021
for counter = yearStart to yearEnd [1]
i_startTime = input(defval = timestamp("23 Aug 2020 00:00 +0000"), title = "Start Time", type = input.time)
i_endTime = input(defval = timestamp("22 Sep 2020 23:59 +0000"), title = "End Time", type = input.time)
i_length = input(defval = 20, title = "Length", type = input.integer)
inDateRange = time >= i_startTime and time <= i_endTime
bgcolor(inDateRange ? color.green : na, 50)
break
I want every 23 Aug - 22 sept have background color
yearStart = input(2015)
monthStart = input(8)
dayStart = input(23)
yearEnd = input(2021)
monthEnd = input(9)
dayEnd = input(22)
inDayMonthRange = time >= timestamp(year, monthStart, dayStart, 0, 0) and time <= timestamp(year, monthEnd, dayEnd, 0, 0)
inYearRange = year >= yearStart and year <= yearEnd
inRange = inDayMonthRange and inYearRange
bgcolor(inRange ? color.green : na, 50)
You don't need to use a loop, pine's execution model executes the script progressively through each historical bar.
year returns each bar's year portion of the timestamp. So as the script progresses through each historical bar, you can test separately if we are in the day/month range, and then also test if it is in your range of years.
im writing an app for accountings of small hotel, i'm working with Visual Studio 2013, on OS: windows 10 (Laptop). After finishing the app just published it using publish wizard, then everything was going great till i copied the published files to another computer contains OS: Windows 7 SP1, the app worked successfully but with a little changes in form design and while preview reports printing.
Here's two pictures to explain what is exactly the problem...
If anyone could explain what's going on and what to do to solve this issue would be respected.
Here's my class which contains printpreviewcontrol code:
Private mRow As Integer = 0
Private newpage As Boolean = True
Private Sub PrintDocument1_PrintPage(sender As Object, e As PrintPageEventArgs) Handles PrintDocument1.PrintPage
Try
Dim font36 = New Font("Playball", 36, FontStyle.Regular)
Dim font8 = New Font("Lora", 8, FontStyle.Regular)
Dim font20 = New Font("Lora", 20, FontStyle.Underline)
Dim font16 = New Font("Lora", 16, FontStyle.Regular)
e.Graphics.DrawString("Riviera Beach Chalets", font36, Brushes.Black, New Rectangle(150, 25, 800, 100))
e.Graphics.DrawString("Accounting Reports", font20, Brushes.Black, New Rectangle(650, 45, 300, 50))
e.Graphics.FillRectangle(Brushes.MistyRose, New Rectangle(101, 741, 19, 19))
e.Graphics.DrawString("Accommondation Revenue or Beach Revenue or CoffeeShop Revenue is 0", font8, Brushes.Black, New Rectangle(125, 745, 500, 30))
e.Graphics.DrawString("Amount Received Total :", font16, Brushes.Black, New Rectangle(570, 735, 500, 50))
e.Graphics.DrawString(Report_Database.reporttot, font16, Brushes.Black, New Rectangle(850, 735, 500, 50))
' sets it to show '...' for long text
Dim fmt As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
fmt.LineAlignment = StringAlignment.Center
fmt.Trimming = StringTrimming.EllipsisCharacter
Dim y As Int32 = e.MarginBounds.Top
Dim rc As Rectangle
Dim x As Int32
Dim h As Int32 = 0
Dim row As DataGridViewRow
' print the header text for a new page
' use a grey bg just like the control
If newpage Then
row = Report_Database.DataGridView1.Rows(mRow)
x = 50
For Each cell As DataGridViewCell In row.Cells
' since we are printing the control's view,
' skip invidible columns
If cell.Visible Then
rc = New Rectangle(x, y, cell.Size.Width, cell.Size.Height)
e.Graphics.FillRectangle(Brushes.LightGray, rc)
e.Graphics.DrawRectangle(Pens.Black, rc)
' reused in the data pront - should be a function
Select Case Report_Database.DataGridView1.Columns(cell.ColumnIndex).DefaultCellStyle.Alignment
Case DataGridViewContentAlignment.BottomRight,
DataGridViewContentAlignment.MiddleRight
fmt.Alignment = StringAlignment.Far
rc.Offset(-1, 0)
Case DataGridViewContentAlignment.BottomCenter,
DataGridViewContentAlignment.MiddleCenter
fmt.Alignment = StringAlignment.Center
Case Else
fmt.Alignment = StringAlignment.Near
rc.Offset(2, 0)
End Select
e.Graphics.DrawString(Report_Database.DataGridView1.Columns(cell.ColumnIndex).HeaderText,
Report_Database.DataGridView1.Font, Brushes.Black, rc, fmt)
x += rc.Width
h = Math.Max(h, rc.Height)
End If
Next
y += h
End If
newpage = False
' now print the data for each row
Dim thisNDX As Int32
For thisNDX = mRow To Report_Database.DataGridView1.RowCount - 1
' no need to try to print the new row
If Report_Database.DataGridView1.Rows(thisNDX).IsNewRow Then Exit For
row = Report_Database.DataGridView1.Rows(thisNDX)
h = 0
' reset X for data
x = 50
' print the data
For Each cell As DataGridViewCell In row.Cells
If cell.Visible Then
rc = New Rectangle(x, y, cell.Size.Width, cell.Size.Height)
' SAMPLE CODE: How To
' up a RowPrePaint rule
If Val(row.Cells(2).Value) = 0 Or Val(row.Cells(3).Value) = 0 Or Val(row.Cells(4).Value) = 0 Then
Using br As New SolidBrush(Color.MistyRose)
e.Graphics.FillRectangle(br, rc)
End Using
End If
e.Graphics.DrawRectangle(Pens.Black, rc)
Select Case Report_Database.DataGridView1.Columns(cell.ColumnIndex).DefaultCellStyle.Alignment
Case DataGridViewContentAlignment.BottomRight,
DataGridViewContentAlignment.MiddleRight
fmt.Alignment = StringAlignment.Far
rc.Offset(-1, 0)
Case DataGridViewContentAlignment.BottomCenter,
DataGridViewContentAlignment.MiddleCenter
fmt.Alignment = StringAlignment.Center
Case Else
fmt.Alignment = StringAlignment.Near
rc.Offset(2, 0)
End Select
e.Graphics.DrawString(cell.FormattedValue.ToString(),
Report_Database.DataGridView1.Font, Brushes.Black, rc, fmt)
x += rc.Width
h = Math.Max(h, rc.Height)
End If
Next
y += h
' next row to print
mRow = thisNDX + 1
If y + h > e.MarginBounds.Bottom Then
e.HasMorePages = True
' mRow -= 1 causes last row to rePrint on next page
newpage = True
Button1.Enabled = True
Button4.Enabled = True
If mRow = Report_Database.DataGridView1.RowCount Then
e.HasMorePages = False
Exit Sub
End If
Return
End If
Next
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical)
End Try
Currently I have 6 images layered over top of each other, each with their own corresponding walk animation frame. Each time you walk the Visible property changes and allows the next animation frame to be seen.
The only problem is the bloody flickering when it is passing through any type of object be it, picturebox, form, command button, etc....
After a tiresome day of research I just can't come up with a solution to fix this.
a little snippet of my code if anyone want's to see:
Select Case CharFrame
Case 1
Avatar(0).Visible = True
Avatar(1).Visible = False
Avatar(2).Visible = False
CharFrame = CharFrame + 1
Case 2
Avatar(0).Visible = False
Avatar(1).Visible = True
Avatar(2).Visible = False
CharFrame = CharFrame + 1
Case 3
Avatar(0).Visible = False
Avatar(1).Visible = False
Avatar(2).Visible = True
CharFrame = 1
End Select
Sleep (Timer)
Avatar(0).Top = Avatar(0).Top + moveY
Avatar(1).Top = Avatar(1).Top + moveY
Avatar(2).Top = Avatar(2).Top + moveY
Avatar(3).Top = Avatar(0).Top
Avatar(4).Top = Avatar(1).Top
Avatar(5).Top = Avatar(2).Top
Avatar(6).Top = Avatar(0).Top
Avatar(7).Top = Avatar(1).Top
Avatar(8).Top = Avatar(2).Top
Avatar(9).Top = Avatar(0).Top
Avatar(10).Top = Avatar(1).Top
Avatar(11).Top = Avatar(2).Top
Loop
Avatar(0).Visible = True
Avatar(1).Visible = False
Avatar(2).Visible = False
Found this with Google:
Private Declare Function LockWindowUpdate Lib "USER32" (ByVal hwndLock As Long) As Long
When you like to stop window updating:
LockWindowUpdate <yourform>.hWnd
If you like to continue
LockWindowUpdate False
Found this, did not try it.