Ik weet 't.. excel en macro's is een moeilijk begrip om uit te leggen.. Ik wil graag twee tellers combineren.. Wat wil ik graag:
1)
if [e6] = [g6] then [e6] = "leeg"
if [e6] = "leeg" then [d12] = [d12] -1
if D12 = < 0 then D12 = 0
+ hoe zet ik een stop op de teller zodat 1) maar 1x op nul komt en niet in een oneindige loop zodat mijn mail steeds afgaat (zie code). Dus als cel e6 op "leeg" komt moet d12 eentje aftrekken tot *nul* en dan niets meer doen tot ik cel e6 weer *handmatig* instel op gewenst die dan weer telt tot *leeg*
en
2)
D12 mag alleen een waarde gaan bevatten Lager/gelijk aan E12 en dus ook niet onder de nul. Werkt normaliter prima. Ik wil dus 1) (zie boven) hiermee combineren.
Als ik een cel wijzig buiten bereik E6/G6/D12 mag er niets gebeuren, want mijn automatische mail gaat steeds af op momenten wanneer ik dat niet wil. het moet aan de voorwaardes voldoen..
1)
if [e6] = [g6] then [e6] = "leeg"
if [e6] = "leeg" then [d12] = [d12] -1
if D12 = < 0 then D12 = 0
+ hoe zet ik een stop op de teller zodat 1) maar 1x op nul komt en niet in een oneindige loop zodat mijn mail steeds afgaat (zie code). Dus als cel e6 op "leeg" komt moet d12 eentje aftrekken tot *nul* en dan niets meer doen tot ik cel e6 weer *handmatig* instel op gewenst die dan weer telt tot *leeg*
en
2)
D12 mag alleen een waarde gaan bevatten Lager/gelijk aan E12 en dus ook niet onder de nul. Werkt normaliter prima. Ik wil dus 1) (zie boven) hiermee combineren.
Als ik een cel wijzig buiten bereik E6/G6/D12 mag er niets gebeuren, want mijn automatische mail gaat steeds af op momenten wanneer ik dat niet wil. het moet aan de voorwaardes voldoen..
Code:
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngResponse As Long
Dim URL As String, strEmail As String, strSubject As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
if [e6] = [g6] then [e6] = "leeg"
if [e6] = "leeg" then [d12] = [d12] -1
If Left(Target.Address, 2) = "$D" Then
If Target.Value < Range("$E" & Right(Target.Address, 2)).Value Then
If Target.Cells.Count < [e12] Then
[b31] = [b31] + 1
strEmail = Range("$g" & Right(Target.Address, 2)).Value
strsubject1 = "Bestelling:"
strsubject2 = Range("$F" & Right(Target.Address, 2)).Value & "x " & Range("$a" & Right(Target.Address, 2)).Value & "<br><br>Typenummer " & Range("$b" & Right(Target.Address, 2)).Value
strsubject3 = "Groet, <br><br>" & Signature
Strurl = "mailto:" & strEmail & "?subject=" & "Bestelling" & "&body=" & strSubject
SigString = "C:\Documents and Settings\cursist\Application Data\Microsoft\handtekeningen\Wom.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strEmail
.CC = ""
.BCC = ""
.Subject = "Bestelling"
.htmlBody = strsubject1 & "<br><br>" & strsubject2 & "<br><br>" & strsubject3 & "<br><Br><Br>" & Signature
.Close
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
End If
End If
End Sub
