![]() |
#1
|
|||
|
|||
![]()
This code works fine but it is vb 6. Do you know how to adapt it for Vba?
Code:
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Const speed As Byte = 1 Dim wid% Dim hei% Dim dc& Const text = " HELLO WORLD!!! " Private Sub Form_load() dc = Picture1.hDC Picture1.CurrentX = 0 Picture1.CurrentY = 0 Picture1.Print text Picture1.ScaleMode = vbPixels wid = Picture1.TextWidth(text) hei = Picture1.TextHeight(text) Picture1.Width = wid * Screen.TwipsPerPixelX Picture1.Height = hei * Screen.TwipsPerPixelY End Sub Private Sub Timer1_Timer() Dim i% For i = 0 To speed BitBlt dc, wid + 1, hei + 1, 1, hei, dc, 0, 0, &HCC0020 ' &hcc0020 is equvilent to vbSrcCopy BitBlt dc, 0, 0, wid, hei, dc, 1, 0, &HCC0020 BitBlt dc, wid, 0, 1, hei, dc, wid + 1, hei + 1, &HCC0020 Next i Picture1.Refresh End Sub |
#2
|
||||
|
||||
![]()
I'm not sure what you mean by label. This code looks like it is displaying a form containing picture on the screen and either moving the picture within that form or the entire form.
If it is a vba userform that you want to move across the screen, something like this works Code:
#If VBA7 And Win64 Then ' For 64bit version of Excel Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr) #Else ' For 32bit version of Excel Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) #End If Private Sub UserForm_Activate() Dim iLastPos As Long, iMove As Long With Me iLastPos = Application.Left + Application.Width - .Width iMove = 10 .Left = Application.Left Do While .Left < iLastPos Sleep 50 .Left = .Left + iMove Loop End With Me.Hide End Sub Private Sub UserForm_Initialize() With Me .Top = Application.Top + 0.5 * (Application.Height - .Height) End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
![]()
Hi Andrew, thanks for answering.
In Spanish, the word "etiqueta" means label. VB6 : VBA 7.1: |
#4
|
|||
|
|||
![]()
Hi Andrew, thanks for answering.
In Spanish, the word "etiqueta" is label in english. VB6 : VBA 7.1: Well, the code Code:
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Const speed As Byte = 1 Dim wid% Dim hei% Dim dc& Const text = " HELLO WORLD!!! " Private Sub Form_load() dc = Picture1.hDC Picture1.CurrentX = 0 Picture1.CurrentY = 0 Picture1.Print text Picture1.ScaleMode = vbPixels wid = Picture1.TextWidth(text) hei = Picture1.TextHeight(text) Picture1.Width = wid * Screen.TwipsPerPixelX Picture1.Height = hei * Screen.TwipsPerPixelY End Sub Private Sub Timer1_Timer() Dim i% For i = 0 To speed BitBlt dc, wid + 1, hei + 1, 1, hei, dc, 0, 0, &HCC0020 ' &hcc0020 is equvilent to vbSrcCopy BitBlt dc, 0, 0, wid, hei, dc, 1, 0, &HCC0020 BitBlt dc, wid, 0, 1, hei, dc, wid + 1, hei + 1, &HCC0020 Next i Picture1.Refresh End Sub Animation.gif I NEED THIS !!!!!!! The problem is that it is in vb6 code, which uses the Timer and I do not have it in vba 7.1. It would be necessary to replace the timer Timer by another. |
#5
|
|||
|
|||
![]()
I would just need to replace Private Sub Timer1_Timer () with this timer, I think:
Code:
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long Public TimerId As Long, Var As Long |
#6
|
||||
|
||||
![]()
You are right, they are called labels in English versions of Office too. OK, try this code where the text is in a label called labelTicker
Code:
#If VBA7 And Win64 Then ' For 64bit versions Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr) #Else ' For 32bit versions Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) #End If Private Sub UserForm_Activate() Dim iWidth As Integer, iFormWidth As Integer, iStep As Integer iStep = 1 iFormWidth = Me.Width - 20 With Me.labelTicker .Left = iFormWidth Do Sleep 20 DoEvents If .Left > -1 * .Width Then .Left = .Left - iStep Else .Left = iFormWidth End If Loop End With End Sub Private Sub UserForm_Initialize() With Me .Top = Application.Top + 0.5 * (Application.Height - .Height) .Left = Application.Left + 0.5 * (Application.Width - .Width) End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
![]()
Wow, its run. Thank you very much, Mr. Andrew.
|
#8
|
|||
|
|||
![]()
Mr. Andrew. Two questions.
1.- If I want to add another message in the same form? 2.- Can I control the speed of the text? Thanks in advance. |
#9
|
||||
|
||||
![]()
1. Yes, you can add a second scrolling message but it is really just a circus trick and just adds clutter to the screen - why would you want two of these running to distract the users?
2. You can control the speed in two ways, alter the size of the Step or alter the delay between each step. The relevant lines are iStep = 1 Sleep 20 For example: If the step = 2, it will move in bigger steps and therefore be faster If Sleep is changed to 40 it will move slower (or change it to 10 to make it faster)
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#10
|
|||
|
|||
![]()
1.-It would not be the same message. In the same form, a new labelticker (labelticker2) with other information.
Please, Tell me how to add another message. |
#11
|
||||
|
||||
![]()
Add the red lines to move a second same-sized label called labelTicker2
Code:
Private Sub UserForm_Activate() Dim iWidth As Integer, iFormWidth As Integer, iStep As Integer iStep = 1 iFormWidth = Me.Width - 20 With Me.labelTicker .Left = iFormWidth Me.labelTicker2.Left = .Left Do Sleep 20 DoEvents If .Left > -1 * .Width Then .Left = .Left - iStep Else .Left = iFormWidth End If Me.labelTicker2.Left = .Left Loop End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#12
|
|||
|
|||
![]()
Thank you very much.
|
#13
|
|||
|
|||
![]()
Hi guessed, By putting the second one, the movement is no longer so fluid. How can I solve it?
|
#14
|
||||
|
||||
![]()
There is a reason that I called this a circus trick - it doesn't really add to the form's useability in any way and it is added complexity that might cause problems.
You have a few choices to make the performance hit less noticeable. 1. Increase the size of the step AND the sleep time 2. Use one text label to contain both lines of text (or put them into the same container and move that one container. 3. Buy a faster computer
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#15
|
|||
|
|||
![]()
Guessed, I have a Zephyrus G14 AMD Ryzen 9 4900HS with Radeon Graphics 3.. GHz. 16 GB RAM. I think there is plenty of fast.
|
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to edit columns and move the right column more to the left? | bchinjy | Word | 3 | 07-29-2019 05:23 AM |
move the milestone label to left of column | wilster31 | Project | 0 | 07-31-2017 07:58 AM |
![]() |
enginist | Word | 4 | 08-03-2014 09:29 PM |
![]() |
pmstock | Word | 2 | 08-02-2014 08:34 PM |
i want to place labels on to the left of the page anchored to words within | soooty | Word | 0 | 07-07-2010 09:18 AM |