Code Aanpassen Werkt Niet

marcel31281 · 11 feb 2020

Bedankt, maar hier kom ik nog niet verder mee. dze code vraagt om een complete map op te slaan en niet alleen het rapport in PDF formaat.

AD1957 · 11 feb 2020

Volgens mij werkt het zo perfect.
Monteur kan kiezen waar het PDF wordt opgeslagen. ( excuus voor het zootje:d, code nog een beetje rangschikken kun je zelf)

Code:

Set fs = CreateObject("Scripting.FileSystemObject")
        
        
        If Not fs.FileExists(ThisWorkbook.Path & "" & TextBox13.Value & "---" & TextBox25.Value & "" & TextBox1.Value & "---" & TextBox2.Value & ".pdf") Then 'controle of bestand al bestaat
        
            Sheets("MULTICARE | ELEGANZA 5").Range("A1:K61").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "" & TextBox13.Value & "---" & TextBox25.Value & "" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
            OpenAfterPublish:=False 'True
        
        Else
        
            'msgbox rapport bestaat al in deze map
            Dim RapportOpslaan As Integer
            
            RapportOpslaan = MsgBox("Dit rapport is al opgeslagen, wil je het overschrijven." & vbCrLf & vbCrLf & _
                                    "Klick op JA om te overschrijven." & vbCrLf & vbCrLf & _
                                    "KLick op NEE om het rappport ergens anders op te slaan." & vbCrLf & vbCrLf & _
                                    "Klick op ANNULEREN om af te sluiten." _
                                    , vbYesNoCancel + vbQuestion, "RAPPORT BESTAAT AL!")
            
            
            If RapportOpslaan = vbYes Then
                Sheets("MULTICARE | ELEGANZA 5").Range("A1:K61").ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=ThisWorkbook.Path & "" & TextBox13.Value & "---" & TextBox25.Value & "" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
                OpenAfterPublish:=False 'True
            End If
            
            If RapportOpslaan = vbNo Then
                'rapport wordt niet opgeslagen/overschreven maar de keuze geven aan monteur
                With Application.FileDialog(msoFileDialogFolderPicker)
                 .InitialFileName = "c:\users" & Environ("username") & "\Desktop" 'Desktop eventueel wijzigen
                 If .Show Then Sheets("MULTICARE | ELEGANZA 5").ExportAsFixedFormat 0, .SelectedItems(1) & "" & TextBox1.Value & "---" & TextBox2.Value & ".pdf"
                End With
                
            Else
                'knop annuleren
                'userform bijwerken en sluiten
                
            End If
            
            
        
           
            
        End If

marcel31281 · 11 feb 2020

Dit lijkt inderdaad tewerken, bedankt

Alleen krijg ik een hele lange en rare bestandsnaaam en ik kan niet vinden waar hij dit vandaan haalt ( Overzicht Onderhoud V3.1.111-02-2020---12345620120014864---72633)

AD1957 · 11 feb 2020

Bij mij werkt het perfect.
wordt opgeslagen in de aangegeven map met waarde uit textbox1---textbox2.
Voorbeeldbestand?

marcel31281 · 11 feb 2020

Bij deze het voorbeeldbestand, zoals ik het nu kan zien neemt hij ook de naam van de map mee in de bestandsnaam van de pdf.

Daarnaast krijg ik direct na de eerste msgBox dat er een map is aangemaakt direct de 2e er achter aan met dat het rapport al opgeslagen is

AD1957 · 11 feb 2020

Zo dan?
Zit wel nog een extra controle in (alle tekstboxen 7t/m12 en de comboboxen moeten zijn ingevuld)

marcel31281 · 11 feb 2020

YES!!!! Bedankt:thumb:

#onderstaande = opgelost

Bedankt voor de extra optie met kleuren van afgekeurd of goedgekeurd, maar het lijkt niet te werken zoals het hoort
ook bij reparatie krijg ik een groene kleur

marcel31281 · 11 feb 2020

Zou aleen fijn zijn voor de monteur dat hij een medling krijgt welke velden niet zijn ingevuld, kan wel een MsgBox maken met dat niet alle velden ingevuld zijn
maar vervolgens gaat hij direct naar de MsgBox met dat het rapport al opgeslagen is

AD1957 · 11 feb 2020

vervang de code van CMB_01 eens met:

Code:

Private Sub CMB_01_Click()

'CONTROLE OF ALLES IS INGEVULD
If TextBox7 <> "" And TextBox8 <> "" And TextBox9 <> "" And TextBox10 <> "" And TextBox11 <> "" And TextBox12 <> "" _
   And TextBox25 <> "" And ComboBox1 <> "" And ComboBox2 <> "" Then
   

        With Sheets("MULTICARE | ELEGANZA 5")
        Application.ScreenUpdating = False
    
            .[F7] = TextBox1
            .[F8] = TextBox2
            .[F9] = TextBox3
            .[I7] = TextBox4
            .[I8] = TextBox5
            .[I9] = TextBox6
            .[E44] = TextBox7
            .[E45] = TextBox8
            .[E46] = TextBox9
            .[E47] = TextBox10
            .[G51] = TextBox11
            .[G52] = TextBox12
            .[C4] = TextBox13
            .[E59] = ComboBox2
            .[C55] = TextBox19
            .[C58] = ComboBox1 'toegevoegd
            .[C5] = TextBox25
            .[C7] = TextBox21
            .[C8] = TextBox22
            .[C9] = TextBox23
            .[C10] = TextBox24
            
            If .[C58].Value = "AFGEKEURD: bed wacht op reparatie/onderdelen" Then
               .[C58].Font.Color = vbRed
            Else
                .[C58].Font.Color = RGB(30, 200, 46)
            End If
            
         End With
            
        '****************************************************************************************************************
        '*********MAP VAN DE DAG AANMAKEN bestaande uit datum en SO nr. van vandaag (textbox13 en textbox24)*************
        If TextBox13 <> "" And TextBox25 <> "" Then
            Dim fs As Object
            Set fs = CreateObject("Scripting.FileSystemObject")
            If Not fs.FolderExists(ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "") Then
            
                MsgBox "Goedendag" & " " & ComboBox2.Value & "," & vbCrLf & vbCrLf & _
               "Er wordt nu een map aangemaakt met de datum en So-nummer van vandaag." & vbCrLf & vbCrLf & _
               "Alle rapporten van vandaag worden hierin opgeslagen." & vbCrLf & vbCrLf & _
               "Ik wens je een productieve dag en hoop dat de map goed vol raakt." & vbCrLf & vbCrLf & _
               "Groet," & vbCrLf & vbCrLf & _
               "Marcel"
               
                MkDir ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & ""
                
            End If
        Else
        MsgBox "er is geen datum of SO nr. ingevuld"
        
        Exit Sub
        
        End If
        '***********EINDE CODE MAP AANMAKEN******************************************************************************
        '****************************************************************************************************************
          
          
          
        '****************************************************************************************************************
        '**********BESTAND OPSLAAN IN DE VANDAAG AANGEMAAKTE MAP*********************************************************
         
       Set fs = CreateObject("Scripting.FileSystemObject")
        
        
        If Not fs.FileExists(ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf") Then 'controle of bestand al bestaat
        
            Sheets("MULTICARE | ELEGANZA 5").Range("A1:K61").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
            OpenAfterPublish:=False 'True
        
        Else
        
            'msgbox rapport bestaat al in deze map
            Dim RapportOpslaan As Integer
            
            RapportOpslaan = MsgBox("Dit rapport is al opgeslagen, wil je het overschrijven." & vbCrLf & vbCrLf & _
                                    "Klick op JA om te overschrijven." & vbCrLf & vbCrLf & _
                                    "KLick op NEE om het rappport ergens anders op te slaan." & vbCrLf & vbCrLf & _
                                    "Klick op ANNULEREN om af te sluiten." _
                                    , vbYesNoCancel + vbQuestion, "RAPPORT BESTAAT AL!")
            
            
            If RapportOpslaan = vbYes Then
                Sheets("MULTICARE | ELEGANZA 5").Range("A1:K61").ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
                OpenAfterPublish:=False 'True
            End If
            
            If RapportOpslaan = vbNo Then
                'rapport wordt niet opgeslagen/overschreven maar de keuze geven aan monteur
                With Application.FileDialog(msoFileDialogFolderPicker)
                 .InitialFileName = "c:\users\" & Environ("username") & "\Desktop\" 'Desktop eventueel wijzigen
                 If .Show Then Sheets("MULTICARE | ELEGANZA 5").ExportAsFixedFormat 0, .SelectedItems(1) & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf"
                End With
                
            Else
                'knop annuleren
                'userform bijwerken en sluiten
                
            End If
           
            
        End If
        '**********EINDE CODE BESTAND OPSLAAN IN DE VANDAAG AANGEMAAKTE MAP*********************************************************
        '***************************************************************************************************************************
        
                
        
        
        '*******ALLES TERUG ZETTEN, checkboxen op True en optionbuttons Nee op true/groen***********************
         For Each ctrl In Frm_Multicare.Controls
            If TypeName(ctrl) = "CheckBox" Then
               ctrl.Value = True
            End If
        Next ctrl
        
        Dim i As Integer
        For i = 2 To 52 Step 2
            Me("OptionButton" & i).Value = True
        
            If Me("OptionButton" & i).Value = True Then
               Me("OptionButton" & i).BackColor = vbGreen
            End If
        Next i
        '***********************************************************************************************************
        
        'vastzetten naam en SO nummer voor vandaag( als het bestand volledig wordt afgesloten wordt naam en so nummer verwijderd)
        With Sheets("-OVERZICHT-")
            .Unprotect "AFTERSALES"
            .Range("S5").Value = ComboBox2.Value
            .Range("S6").Value = TextBox25.Value
            .Protect "AFTERSALES"
        End With
        
        Unload Me
        
        
Else 'else van de 1e IF controle of alles is ingevuld
      MsgBox "Je hebt niet alles ingevuld, controleer de invulvelden" & vbCrLf & vbCrLf & _
           "ELECTRISCHE VEILIGHEIDSTEST" & vbCrLf & _
           "WEEGUNIT CONTROLE" & vbCrLf & _
           "NAAM" & vbCrLf & _
           "RESULTAAT"
End If

End Sub

marcel31281 · 11 feb 2020

Wederom bedankt, ik denk dat ik met de code nu een heel eind ben.

Alleen hoe krijg ik in de laatste code vbExclamation of vbCritical toegevoegd, heb het al op verschillende manieren geprobeerd maar het wil niet lukken

AD1957 · 11 feb 2020

Code:

MsgBox "Je hebt niet alles ingevuld, controleer de invulvelden" & vbCrLf & vbCrLf & _
           "ELECTRISCHE VEILIGHEIDSTEST" & vbCrLf & _
           "WEEGUNIT CONTROLE" & vbCrLf & _
           "NAAM" & vbCrLf & _
           "RESULTAAT", _
           vbOKOnly + vbCritical, "NIET ALLE VELDEN ZIJN INGEVULD"

marcel31281 · 11 feb 2020

Bedankt, ik denk dat ik alles nu wel heb om het bestand goed werkend te krijgen. Nogmaals bedankt voor je hulp en het delen van je kennis met vba.

Als laatste wil ik vragen of je nog eens wil kijken dat als de checkboxes beide uitstaan, het groene bolletje ook automatisch verdwijnt.

Voor nu ga ik de komende tijd het bestand helemaal op orde maken en kijken of er wellicht nog bugs in zitten.

Nogmaals enorm bedankt :thumb::thumb::thumb::thumb::thumb:

AD1957 · 11 feb 2020

je kennis met vba.

moet nog heel veel leren,ik probeer nu de codes in Klassemodules te zetten.

Als laatste wil ik vragen of je nog eens wil kijken dat als de checkboxes beide uitstaan, het groene bolletje ook automatisch verdwijnt.

Zal er eens naar kijken, maar eigenlijk zou je dat ook zelf moeten kunnen oplossen.

AD1957 · 11 feb 2020

waarschijnlijk zoiets:

Code:

Private Sub CheckBox1_Click()
 With Sheets("MULTICARE | ELEGANZA 5")
    If CheckBox1 = False Then
        .Range("F14") = "N/A"
        .Range("F14").Font.Name = "Arial"
        .Range("F14").Font.Size = 10
        [COLOR="#FF0000"]If CheckBox2 = False Then .Range("I14") = ""[/COLOR]
    Else
        .Range("F14") = "ü"
        .Range("F14").Font.Name = "Wingdings"
        .Range("F14").Font.Size = 18
    End If
 End With
End Sub
Private Sub CheckBox2_Click()
 With Sheets("MULTICARE | ELEGANZA 5")
    If CheckBox2 = False Then
        .Range("G14") = "N/A"
        .Range("G14").Font.Name = "Arial"
        .Range("G14").Font.Size = 10
        [COLOR="#FF0000"]If CheckBox1 = False Then .Range("I14") = ""[/COLOR]
    Else
        .Range("G14") = "ü"
        .Range("G14").Font.Name = "Wingdings"
        .Range("G14").Font.Size = 18
    End If
 End With
End Sub

Tja dat wordt dan weer een hoop tikwerk, of met Klassemodules, maar zover ben ik nog niet.

Ga nu van mijn welverdiende rust genieten. HAD IK NU MAAR EEN GOED BED!!:d:d:d:d

marcel31281 · 11 feb 2020

hahahaha was zelf ook aan het rommelen gegaan en kwam op dezelfde oplosssing

Toch bedankt voor je snelle reactie!!:thumb:

Het is bijna 17:00 voor mij ook tijd om naar huis te gaan en uit te rusten, zie alleen nog maar code voor mijn ogen

marcel31281 · 16 feb 2020

Toch nog een klein vraagje, zou het mogelijk zijn dat de checkboxes die je uitzet (optie niet aanwezig op bed) deze voor de rest van de dag onthouden word.
Het is best vervelend als je een huis hebt met allemaal zelfde bedden, je dit steeds opnieuw moet doen

Alvast bedankt voor het meedenken

AD1957 · 16 feb 2020

Zal waarschijnlijk wel gaan. Post je huidige bestand even.

marcel31281 · 16 feb 2020

Bij deze...

AD1957 · 16 feb 2020

wijzig

Code:

Unload Me

eens in

Code:

 Me.Hide
         For i = 7 To 12
         Me("TextBox" & i) = ""
         Next i
        
         ComboBox1 = ""

wel nog even de optionbuttons controleren.
Heb het zelf nog niet getest.

AD1957 · 16 feb 2020

en dit uitschakelen

Code:

       [COLOR="#008000"]'*******ALLES TERUG ZETTEN, checkboxen op True en optionbuttons Nee op true/groen***********************[/COLOR]
         For Each ctrl In Frm_Multicare.Controls
           If TypeName(ctrl) = "CheckBox" Then
               ctrl.Value = True
            End If
        Next ctrl

Code Aanpassen Werkt Niet

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Bijlagen

Verenigingslid

Bijlagen

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Verenigingslid

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Bijlagen

Verenigingslid

Verenigingslid

Wij waarderen jouw privacy