| Forfatter |
 Emne Søg  Emne funktioner
|
Hartig 
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
 Emne: Hvordan stopper jeg min macro IF ?
Sendt: 17.Dec.2018 kl. 09:48 |
Jeg har en en række tjeklister, hvor jeg har indsat en Command Button til automatisk at gemme som PDF-fil på en fast lokation. Jeg kunne dog godt tænke mig at stoppe macroen med en infobesked, hvis der stadigvæk er røde felter tilbage i arket. Arket er nemlig opbygget på en sådan måde, at alle felter/rækker der skal udfyldes, men ikke er blevet det endnu, bliver vha Conditional Formatting farvet røde (RGB(248, 203, 173)), hvis de ikke er blevet udfyldt. Min savemacro ser således ud: Private Sub GemSomPDF_Click()
If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If 'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\" 'Build File Name from Sheet1 A3, C4 & C2
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4") 'Export as PDF to Folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
End Sub
|
 |
|
|
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
 Accepteret svar
Sendt: 17.Dec.2018 kl. 11:41 |
|
Jeg prøver lige igen (fejl i første paste).
Private Sub GemSomPDF_Click()
Dim rngCheck As Range
Dim cllCheck As Range
Dim bRedCell As Boolean
If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If
'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\"
'Build File Name from Sheet1 A3, C4 & C2
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4")
'Export as PDF to Folder
Set rngCheck = ActiveSheet.Range("A1:D10") 'Justér til det område dine celler befinder sig i
For Each cllCheck In rngCheck.Cells
If cllCheck.DisplayFormat.Interior.Color = RGB(248, 203, 173) Then
MsgBox "Der er stadig røde felter i arket", vbOKOnly + vbInformation, "Felt-tjek"
bRedCell = True
Exit For
End If
Next cll
If Not bRedCell Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
Else
MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbInformation, "PDF-fil blev ikke gemt"
End If
End Sub
|
|
Mads32
Guld bruger
Medlem: 26.Feb.2016
Land: Danmark
Status: Offline
Point: 1317
|
Sendt: 17.Dec.2018 kl. 11:32 |
|
Du mangler end if, efter din sidste if kommando
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 17.Dec.2018 kl. 11:40 |
|
Man kan godt udelade End If, hvis sætningen skrives på én linje.
Herunder er mit forslag.
Private Sub GemSomPDF_Click()
Dim rngCheck As Range
Dim cllCheck As Range
Dim bRedCell As Boolean
If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If
'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\"
'Build File Name from Sheet1 A3, C4 & C2
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4")
'Export as PDF to Folder
Set rngCheck = ActiveSheet.Range("A1:D10") 'Justér til det område dine celler befinder sig i
For Each cll In rngCheck.Cells
If cll.DisplayFormat.Interior.Color = RGB(248, 203, 173) Then
MsgBox "Der er stadig røde felter i arket", vbOKOnly + vbInformation, "Felt-tjek"
bRedCell = True
Exit For
End If
Next cll
If Not bRedCell Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
Else
MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbInformation, "PDF-fil blev ikke gemt"
End If
End Sub
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Accepteret svar
Sendt: 17.Dec.2018 kl. 11:41 |
|
Jeg prøver lige igen (fejl i første paste).
Private Sub GemSomPDF_Click()
Dim rngCheck As Range
Dim cllCheck As Range
Dim bRedCell As Boolean
If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If
'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\"
'Build File Name from Sheet1 A3, C4 & C2
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4")
'Export as PDF to Folder
Set rngCheck = ActiveSheet.Range("A1:D10") 'Justér til det område dine celler befinder sig i
For Each cllCheck In rngCheck.Cells
If cllCheck.DisplayFormat.Interior.Color = RGB(248, 203, 173) Then
MsgBox "Der er stadig røde felter i arket", vbOKOnly + vbInformation, "Felt-tjek"
bRedCell = True
Exit For
End If
Next cll
If Not bRedCell Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
Else
MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbInformation, "PDF-fil blev ikke gemt"
End If
End Sub
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 17.Dec.2018 kl. 12:03 |
Hej maxzpad 1.000 tak for dit svar. Jeg har nu prøvet at klippe det ind. Dog skriver den følgende (billede):
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 17.Dec.2018 kl. 12:44 |
Ahr... endnu en fejl/forglemmelse fra min side  Der skal stå cllCheck i stedet for cll.
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 17.Dec.2018 kl. 12:55 |
Jeg ved simpelthen ikke hvad jeg gør galt.  Nu gemmer den som normalt også selvom der er røde felter i arket. Farvekoden er jeg ellers 99% sikker på, da jeg har været inde og finde den vha. en macro. (Jeg er super taknemmeligt for du gider at hjælpe!!) Private Sub GemSomPDF_Click() Dim rngCheck As Range
Dim cllCheck As Range
Dim bRedCell As Boolean If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If
'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\"
'Build File Name from Sheet1 A3, C4 & C2
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4")
'Export as PDF to Folder
Set rngCheck = ActiveSheet.Range("A1:E200")
For Each cllCheck In rngCheck.Cells
If cllCheck.DisplayFormat.Interior.Color = RGB(248, 203, 173) Then
MsgBox "Der er stadig røde felter i arket", vbOKOnly + vbInformation, "Felt-tjek"
bRedCell = True
Exit For
End If
Next cllCheck
If Not bRedCell Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
Else
MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbInformation, "PDF-fil blev ikke gemt"
End If End Sub
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 17.Dec.2018 kl. 13:14 |
|
Det er klart, at hvis ikke farvekoden rammes spot-on, så vil det ikke fungere.
En måde at finde farvekoden på er, at du stiller dig i en celle, hvor farven er, og herefter skal du over i VBE (Visual Basic Editor) med Alt+F11 og skrive følgende i Immediate-vinduet (Ctrl+G hvis det ikke er vist allerede):
?ActiveCell.DisplayFormat.Interior.Color [tryk Enter]
Dette returnerer farvekoden som en talværdi, som du kan bruge i koden således:
If cllCheck.DisplayFormat.Interior.Color = 11389944 Then
11389944 er den farvekode, jeg får retur, når jeg først har sat farven til RGB(248, 203, 173).
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 17.Dec.2018 kl. 13:29 |
Fantastisk !!!!  Nu virker det. Det må være en forkert farvekode!! Jeg fik denne kode retur: 8696052
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 17.Dec.2018 kl. 13:31 |
|
Selv tak. Markér gerne løsningen som "Accepteret løsning".
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 19.Dec.2018 kl. 13:07 |
Hej igen Max.  Nu har vi kørt med løsningen i et par dage, og det fungerer bare!! Men så kom jeg til at tænke på i dag, om det egentligt er muligt med mere end 1 IF kommando i samme macro? Det som jeg nemlig tænker på, det er om det evt. ville være muligt for macroen at gemme som PDF, når der ikke er flere røde felter tilbage (det du hjalp med, som virker perfekt!!), men hvis der så er 1 eller flere "x'er" i kolonne D, som er "Ikke OK" i tjeklisten, så sender den automatisk en mail hvor man bruger informationen fra celle A3 + A4 i emnefeltet. Fx emne: "Iflg. PM WO "A3", er en eller flere ting hos "A4" Ikke OK." Jeg ved ikke om det overhovedet kan lade sig gøre? Mvh Kenneth. Macroen ser på nuværende tidspunkt således ud: Private Sub GemSomPDF_Click() Dim rngCheck As Range
Dim cllCheck As Range
Dim bRedCell As Boolean If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then
MkDir "c:\1_Gemte Tjeklister"
End If
'Set path to Folder
fPath = "c:\1_Gemte Tjeklister\"
'Build File Name from Sheet1 A3, A4 & C4
fName = Range("A3") & "-" & _
Range("A4") & "-" & _
Range("C4")
'Export as PDF to Folder
Set rngCheck = ActiveSheet.Range("A1:E200")
For Each cllCheck In rngCheck.Cells
If cllCheck.DisplayFormat.Interior.Color = 8696052 Then
MsgBox "Der er stadig røde felter i PM tjeklisten", vbOKOnly + vbCritical, "Felt-tjek"
bRedCell = True
Exit For
End If
Next cllCheck
If Not bRedCell Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation
Else
MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbCritical, "PDF-fil blev ikke gemt"
End If End Sub
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 19.Dec.2018 kl. 14:41 |
|
Hvis der findes x'er i kolonne D, skal PDF'en så stadig genereres? Og hvis ja, ville det så tjene et formål at vedhæfte PDF'en i e-mailen?
Hvem skal i øvrigt være modtager af e-mailen? Og er det Outlook, som er mailprogram?
Det kan sagtens lade sig gøre, men det kræver lidt mere kode (og dermed tid).
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 19.Dec.2018 kl. 14:55 |
PDF-filen skal stadigvæk genereres, som hidtil. Hvis der bliver sat kryds i "Ikke OK", så skal vi oprette det der hedder en WO (Work Order) i vores system, så vi kan sikre at det bliver udbedret. Som det er nu, så ringer vi ind til vores kundeservice og fortæller dem hvad der er "Ikke OK", så de opretter en WO på dette. Men hvis arket kunne sende dem en mail automatisk med de oplysninger de skal bruge, så ville det være super smart både for dem der kører i marken og dem der sidder i kundeservice.  Vi bruger Outlook som mailprogram. Det ser således ud til dem i marken:
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 19.Dec.2018 kl. 15:00 |
Hej Kenneth I det nedenstående skal du udskifte .To = "dig@ditdomæne.dk" med e-mailadressen til jeres kundeservice. Jeg har ikke mulighed for at teste det, så det må du stå for --- VBA-kode ---- Private Sub GemSomPDF_Click() Dim rngCheck As Range Dim cllCheck As Range Dim bRedCell As Boolean Dim bCheckX As Boolean Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Dim sht As Worksheet Set sht = ActiveSheet If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then MkDir "c:\1_Gemte Tjeklister" End If 'Set path to Folder fPath = "c:\1_Gemte Tjeklister\" 'Build File Name from Sheet1 A3, A4 & C4 With sht fName = .Range("A3") & "-" & _ .Range("A4") & "-" & _ .Range("C4") End With 'Export as PDF to Folder Set rngCheck = sht.Range("A1:E200") For Each cllCheck In rngCheck.Cells If cllCheck.DisplayFormat.Interior.Color = 8696052 Then MsgBox "Der er stadig røde felter i PM tjeklisten", vbOKOnly + vbCritical, "Felt-tjek" bRedCell = True Exit For End If Next cllCheck Set rngCheck = sht.Range("D1:D200") For Each cllCheck In rngCheck.Cells If UCase(cllCheck) = "X" Then bCheckX = True Exit For End If Next cllCheck If Not bRedCell Then sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation If bCheckX Then With OutMail .To = "dig@ditdomæne.dk" .Attachments.Add fPath & fName .CC = "" .BCC = "" .Subject = "Iflg. PM WO " & sht.Range("A3") & ", er en eller flere ting hos " & sht.Range("A4") & " Ikke OK." .display .HTMLbody = "<HTML><BODY>" & _ "Hej [modtager]" & _ "<br><br>" & _ "Vedhæftet er filen med ..." & _ "<br><br>" & _ "</BODY></HTML>" & _ "<br><br>" & _ OutMail.HTMLbody End With End If End If Else MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbCritical, "PDF-fil blev ikke gemt" End If End Sub
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 19.Dec.2018 kl. 15:18 |
Det er dybt imponerende hvad du og det kan!!  Dog går den i fejl når jeg kører den.
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 19.Dec.2018 kl. 15:42 |
|
Ok. Det er fordi fName ikke indeholder PDF-filens "efternavn" (extension).
Prøv med dette:
.Attachments.Add fPath & fName & ".pdf"
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 19.Dec.2018 kl. 20:27 |
Det var derfor. Nu kører det perfekt!! Det er simpelthen genialt!! Ville det egentligt være muligt at komme med en JA/NEJ spørgeboks inden, så man kan vælge hvor vidt man ønsker der skal sendes en mail på oprettelse af ny wo eller ej??
|
|
maxzpad
Guld bruger
Medlem: 04.Aug.2016
Land: Danmark
Status: Offline
Point: 709
|
Sendt: 20.Dec.2018 kl. 08:34 |
Nu med spørgsmål inden e-mail.... Private Sub GemSomPDF_Click() Dim rngCheck As Range Dim cllCheck As Range Dim bRedCell As Boolean Dim bCheckX As Boolean Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Dim sht As Worksheet Set sht = ActiveSheet If Len(Dir("c:\1_Gemte Tjeklister", vbDirectory)) = 0 Then MkDir "c:\1_Gemte Tjeklister" End If 'Set path to Folder fPath = "c:\1_Gemte Tjeklister\" 'Build File Name from Sheet1 A3, A4 & C4 With sht fName = .Range("A3") & "-" & _ .Range("A4") & "-" & _ .Range("C4") End With 'Export as PDF to Folder Set rngCheck = sht.Range("A1:E200") For Each cllCheck In rngCheck.Cells If cllCheck.DisplayFormat.Interior.Color = 8696052 Then MsgBox "Der er stadig røde felter i PM tjeklisten", vbOKOnly + vbCritical, "Felt-tjek" bRedCell = True Exit For End If Next cllCheck If Not bRedCell Then sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False If Err = 0 Then MsgBox "PM tjekliste er gemt med succes. Den kan findes i C:\Gemte Tjeklister\ når den skal vedhæftes WO i IFS.", vbInformation Set rngCheck = sht.Range("D1:D200") For Each cllCheck In rngCheck.Cells If UCase(cllCheck) = "X" Then bCheckX = True Exit For End If Next cllCheck If bCheckX Then If MsgBox("Iflg. PM WO " & sht.Range("A3") & ", er en eller flere ting hos " & sht.Range("A4") & " Ikke OK." & vbNewLine & vbNewLine & _ "Vil du sende en e-mail til kundeservice med besked om ny WO?", _ vbYesNo + vbQuestion, "Send e-mail vedr. ny WO?") = vbYes Then With OutMail .To = "kenneth.hartig@tomra.com" .Attachments.Add fPath & fName & ".pdf" .CC = "" .BCC = "" .Subject = "Iflg. PM WO " & sht.Range("A3") & ", er en eller flere ting hos " & sht.Range("A4") & " Ikke OK." .display .HTMLbody = "<HTML><BODY>" & _ "Hej [modtager]" & _ "<br><br>" & _ "Vedhæftet er filen med ..." & _ "<br><br>" & _ "</BODY></HTML>" & _ "<br><br>" & _ OutMail.HTMLbody End With End If End If End If Else MsgBox "PDF-filen blev ikke gemt pga. røde felter", vbOKOnly + vbCritical, "PDF-fil blev ikke gemt" End If End Sub
|
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 20.Dec.2018 kl. 11:09 |
Tak Max det er perfekt !! Rigtig glædelig jul og endnu engang 1.000 tak for hjælpen. |
|
Hartig
Bronze bruger
Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
|
Sendt: 08.Mar.2019 kl. 10:43 |
Hej igen Max Ved du evt. hvad der går galt her?? Den går i runtime error 1004, men kun ved nogle bestemte kundenumre Det er ikke kun på min computer den gør dette, men på alles computere. Det eneste jeg kan se der er af sammenhæng imellem de kundenumre hvor det sker, er at de har A/S efter butiksnavnet. Kan det være fordi den ikke vil oprette et filnavn hvis der er "/" i det?? (og kan man evt. komme uden om dette??)
|
|
Forum start
Forummets regler
Sådan uploader du filer
Del dine regneark
Excel-regneark.dk
Hvordan stopper jeg min macro IF ?
