Hello, I am working on a project in Excel:

My plan is to fix a simulation in excel and then create an
image of a vessel which is build out of blue lines stapled on each
other. With VBA want link the lines with values in
the excel sheet which turns the blue lines transparant. That way it
looks like the vessel is
emptying. I guess I also have to put in a time delay or some kind
between execution of the code.

So far the simulation is done, except the vba part. Therefore my
question is how I begin to fix this, and is it even possible? I am a
little bit familiar with VBA. Is there some simple way to change the
properties of these lines?

Sketch:

___________________ Blue lines. if a value becomes below the level of
this it should turn transparant.
___________________
___________________
___________________
___________________
___________________

If there is anyone with ideas, I am open for suggestions.

Robert, Here is some code that I use in a novelty program that I wrote.
Maybe you can use some to the technique to do what you want to do. I am
using interior colors in cells, but you could probably adapt it to line
objects just as well. Anyway, feel free to use it for what it is worth.
There are two time delay methods used. The WaitTime method is limited to one
second minimum delay, whereas the timer method uses tenths of seconds. There
are calls for sound bites in the code that I have commented out because they
require additional declarations that I have not included.

If you run this code, be sure you have your other Excel files closed and put
this in its own file.


Sub WaitTime()
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
sitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait sitTime
End Sub



Public Function HalfSecDly()
y = Timer + 0.5
Do While Timer < y
DoEvents
Loop
End Function

Public Function TenthSecDly()
y = Timer + 0.1
Do While Timer < y
DoEvents
Loop
End Function

Sub ColrStripe() 'Makes horizontal color bars
Dim MyRange As Variant
Dim counter As Long
Dim s As Single
counter = 1
'PlayColors
Do Until counter = 45
MyClrValue = Int((55 * Rnd) + 1)
Range(Cells(counter, 1), Cells(counter + 1,
16)).Interior.ColorIndex = MyClrValue
TenthSecDly
counter = counter + 2
Loop
HalfSecDly
Range("$A$1:$R$45").Interior.Color = RGB(255, 200, 100)
counter = 44
'PlayColors
Do Until counter = 0
MyClrValue = Int((55 * Rnd) + 1)
Range(Cells(counter, 1), Cells(counter + 1,
16)).Interior.ColorIndex = MyClrValue
TenthSecDly
counter = counter - 2
Loop
Worksheets(2).Cells.Clear
Range("$A$1:$R$45").Interior.Color = RGB(255, 200, 100)
MyRange = Array(Range("$A$1:$Q$8"), Range("$A$9:$Q$16"),
Range("$A$17:$Q$25"), Range("$A$26:$Q$34"), Range("$A$35:$Q$45"))
Ttop = Array(35, 130, 250, 350, 445)
counter = 0
Do
Set newWordArt =
Worksheets(2).Shapes.AddTextEffect(PresetTextEffec t:=msoTextEffect + (counter
+ 3), Text:="WATCH THIS", FontName:="Ravie", FontSize:=26, FontBold:=True,
FontItalic:=False, Left:=300, Top:=Ttop(counter))
Worksheets(2).Shapes(counter + 1).Fill.ForeColor.RGB = RGB(100, 255,
255)
MyRange(counter).Interior.ColorIndex = (counter + 2)
'PlayMe
WaitTime
counter = counter + 1
Loop Until counter = 5
HalfSecDly
counter = 4
Do
Worksheets(2).Shapes(counter + 1).Delete
MyRange(counter).Interior.Color = RGB(255, 200, 100)
'PlayInfo
HalfSecDly
counter = counter - 1
Loop While counter = 0
ActiveSheet.Cells.Clear
End Sub

"Robert" wrote:

Hello, I am working on a project in Excel:

My plan is to fix a simulation in excel and then create an
image of a vessel which is build out of blue lines stapled on each
other. With VBA want link the lines with values in
the excel sheet which turns the blue lines transparant. That way it
looks like the vessel is
emptying. I guess I also have to put in a time delay or some kind
between execution of the code.

So far the simulation is done, except the vba part. Therefore my
question is how I begin to fix this, and is it even possible? I am a
little bit familiar with VBA. Is there some simple way to change the
properties of these lines?

Sketch:

___________________ Blue lines. if a value becomes below the level of
this it should turn transparant.
___________________
___________________
___________________
___________________
___________________

If there is anyone with ideas, I am open for suggestions.

You might want to go through the code and change all references to
Worksheets(2) to ActiveSheet so it will run on whatever sheet you have active
when you initiate the macro.

"Robert" wrote:

Hello, I am working on a project in Excel:

My plan is to fix a simulation in excel and then create an
image of a vessel which is build out of blue lines stapled on each
other. With VBA want link the lines with values in
the excel sheet which turns the blue lines transparant. That way it
looks like the vessel is
emptying. I guess I also have to put in a time delay or some kind
between execution of the code.

So far the simulation is done, except the vba part. Therefore my
question is how I begin to fix this, and is it even possible? I am a
little bit familiar with VBA. Is there some simple way to change the
properties of these lines?

Sketch:

___________________ Blue lines. if a value becomes below the level of
this it should turn transparant.
___________________
___________________
___________________
___________________
___________________

If there is anyone with ideas, I am open for suggestions.

It is quite simple to draw directly on either a Userform or the sheet with
the Windows API.
Here is an example of that, which you will have to work out to make your
boat.
This is a project with a Userform, called UserForm1 and a normal module.
The userform has 2 commandbuttons, CommandButton1 and CommandButton2 and
2 option button OptionButton1 and OptionButton2.

This code will go in the userform module:

Option Explicit
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private bPaintUserForm As Boolean

Private Sub CommandButton1_Click()

Dim i As Long
Dim hWnd As Long
Dim siInsideWidth As Single

bPaintUserForm = OptionButton1.Value

If bPaintUserForm Then
Repaint
hWnd = FindWindow(vbNullString, Caption)
Else
hWnd = Application.hWnd
End If

i = 1
siInsideWidth = InsideWidth - 4

SetFixedDrawingParameters hWnd, InsideWidth, InsideHeight

Do While i < siInsideWidth
i = i + 1
DrawLineForm True, _
i, _
0, _
Height - 40, _
10, _
0, _
1, _
vbRed, _
False, _
Me
Sleep 20
Loop

DeletePen

End Sub

Private Sub CommandButton2_Click()
If bPaintUserForm Then
Repaint
Else
Application.ScreenUpdating = True
End If
End Sub


And this code will go into the normal code module:

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private dPointsPerPixel As Single
Private Declare Function DeleteObject _
Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreatePen _
Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function SelectObject _
Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const PS_DOT = 2
Private gPen As Long

'a point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX As Long = 88 'pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'pixels/inch in Y
Private Const TWIPSPERINCH As Long = 1440

Private Declare Function GetDC _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC _
Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function MoveToEx _
Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
lpPoint As POINTAPI) As Long
Private Declare Function LineTo _
Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Private lFarRight As Long
Private lFarBottom As Long
Private hWnd As Long
Private hDC As Long

Sub LoadForm()

Load UserForm1
UserForm1.Show

End Sub

Sub SetFixedDrawingParameters(hWnd As Long, _
lRightEnd As Long, _
lBottomEnd As Long)

dPointsPerPixel = PointsPerPixel()

lFarRight = lRightEnd / dPointsPerPixel
lFarBottom = lBottomEnd / dPointsPerPixel

hDC = GetDC(hWnd)

End Sub

Sub DrawLineForm(bVertical As Boolean, _
lXVertical As Long, _
lYHorizontal As Long, _
lFromEdge1 As Long, _
lFromEdge2 As Long, _
lPenType As Long, _
lPenWidth As Long, _
ByVal lPenColour As Long, _
bDoRepaint As Boolean, _
Optional frmForm As Object)

Dim pCoord As POINTAPI
Dim lXVerticalNew As Long
Dim lYHorizontalNew As Long
Dim lFromEdge1New As Long
Dim lFromEdge2New As Long

lFromEdge1New = lFromEdge1 / dPointsPerPixel
lFromEdge2New = lFromEdge2 / dPointsPerPixel
lXVerticalNew = lXVertical / dPointsPerPixel
lYHorizontalNew = lYHorizontal / dPointsPerPixel

'this will have to be done in a better way
'-----------------------------------------
If bDoRepaint Then
If frmForm Is Nothing Then
Application.ScreenUpdating = True
Else
frmForm.Repaint
End If
End If

'Create the pen
gPen = CreatePen(lPenType, lPenWidth, lPenColour)

'Select the pen onto the DC, deleting the old one
DeleteObject SelectObject(hDC, gPen)

If bVertical Then
'Move the drawing position
pCoord.X = lXVerticalNew
pCoord.Y = lFromEdge1New
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord
'Draw the line
LineTo hDC, lXVerticalNew, lFarBottom - lFromEdge2New
Else
'Move the drawing position
pCoord.X = lFromEdge1New
pCoord.Y = lYHorizontalNew
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord
'Draw the line
LineTo hDC, lFarRight - lFromEdge2New, lYHorizontalNew
End If

End Sub

Sub DeletePen()
DeleteObject gPen
End Sub

Function PointsPerPixel() As Double

'will give the size of a pixel in points
'this will be the same factor for X and Y
'for the screen, but not always for the printer
'----------------------------------------------
Dim hDC As Long
Dim lDotsPerInch As Long

hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC

End Function


Then just run the Sub LoadForm and start experimenting.
By drawing all diffferent lines and colours you could make it as realistic
as you want.


RBS


"Robert" wrote in message
ups.com...
Hello, I am working on a project in Excel:

My plan is to fix a simulation in excel and then create an
image of a vessel which is build out of blue lines stapled on each
other. With VBA want link the lines with values in
the excel sheet which turns the blue lines transparant. That way it
looks like the vessel is
emptying. I guess I also have to put in a time delay or some kind
between execution of the code.

So far the simulation is done, except the vba part. Therefore my
question is how I begin to fix this, and is it even possible? I am a
little bit familiar with VBA. Is there some simple way to change the
properties of these lines?

Sketch:

___________________ Blue lines. if a value becomes below the level of
this it should turn transparant.
___________________
___________________
___________________
___________________
___________________

If there is anyone with ideas, I am open for suggestions.

Thanks for all of the great suggestions and example code. However, I
am not a VBA guru and therefor decided to stick with easy functions
like this:

I use labels with a height of 0,75 so they appear to be lines.

Private Sub labelcolorchange()

Application.Wait Now + TimeValue("0:00:05")

If Cells(1, "A").Value <= Cells(1, "B").Value Then
Label1.BorderColor = RGB(0, 0, 205)
Label1.ForeColor = RGB(0, 0, 205)
Label1.BackColor = RGB(0, 0, 205)

Else

Label1.BorderColor = RGB(0, 0, 10)
Label1.ForeColor = RGB(0, 0, 10)
Label1.BackColor = RGB(0, 0, 10)

End If
End Sub

Maybe I can use your advanced code in a later state.

Yes, if it works then keep it simple.
Another option might be (and simpler I think) is
to run a progressbar in the statusbar:

Sub StatusProgressBar(lCounter As Long, _
lMax As Long, _
lInterval As Long, _
Optional strText As String)

Dim lStripes As Long

If lCounter Mod lInterval = 0 Then
lStripes = Round((lCounter / lMax) * 100, 0)
Application.StatusBar = strText & _
String(lStripes, "|") & _
String(100 - lStripes, ".") & "|"
End If

End Sub


RBS


"Robert" wrote in message
ups.com...
Thanks for all of the great suggestions and example code. However, I
am not a VBA guru and therefor decided to stick with easy functions
like this:

I use labels with a height of 0,75 so they appear to be lines.

Private Sub labelcolorchange()

Application.Wait Now + TimeValue("0:00:05")

If Cells(1, "A").Value <= Cells(1, "B").Value Then
Label1.BorderColor = RGB(0, 0, 205)
Label1.ForeColor = RGB(0, 0, 205)
Label1.BackColor = RGB(0, 0, 205)

Else

Label1.BorderColor = RGB(0, 0, 10)
Label1.ForeColor = RGB(0, 0, 10)
Label1.BackColor = RGB(0, 0, 10)

End If
End Sub

Maybe I can use your advanced code in a later state.