• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro probleem celeigenschappen

Status
Niet open voor verdere reacties.

Arnese

Gebruiker
Lid geworden
3 feb 2011
Berichten
47
Hallo,

Ik probeer tevergeefs een code te perfectioneren.

Doel is om het wordbestand te openen, CTRL A, CTRL C en dan wordt de Excelfile geopend waarbij je in cel A1 CTRL C doet.
Daarna klik je op prijsopmaken. Dit werkt allemaal maar als je de "tabel" bekijkt ( en de code ) dan zie je dat ik probeer om de linkerkant van de tabel een lijn probeer te voorzien via celeigenschappen.
Ik heb al oneindig geprobeerd maar vindt niet waarom hij het niet wil doen.

Kan iemand helpen?Bekijk bijlage 311657Bekijk bijlage 311659
 
Probeer eens de volgende code:
Code:
Sub randfix2()
Dim eerste_regel As Long
Dim laatste_regel As Long
Dim i As Long

With ThisWorkbook.Sheets(1)
    laatste_regel = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To laatste_regel
        If .Cells(i, "A").Value = "Ref." Then
            eerste_regel = i
            i = laatste_regel
        End If
    Next i
    .Range(.Cells(eerste_regel, "A"), .Cells(laatste_regel, "E")).Borders.LineStyle = xlContinuous
End With

End Sub
 
Dag Peter,

Doet precies wat ik uren op gezocht heb. Ik begrijp niet goed wat er verkeerd was aan mijn macro opname.
Enig idee hoe ik de rand via jouw code ook dikker krijg zoals de rest van de "tabel"?
 
Dan zou ik het zo doen. De range "vastzetten" en dan vervolgens alle eigenschappen die je wilt aanpassen:
Code:
Sub randfix2()
Dim eerste_regel As Long
Dim laatste_regel As Long
Dim i As Long
Dim rngTabel As Range

With ThisWorkbook.Sheets(1)
    laatste_regel = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To laatste_regel
        If .Cells(i, "A").Value = "Ref." Then
            eerste_regel = i
            i = laatste_regel
        End If
    Next i
    Set rngTabel = .Range(.Cells(eerste_regel, "A"), .Cells(laatste_regel, "E"))
End With
With rngTabel.Borders
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

End Sub
 
Dag Peter,

Werkt perfect, echter de Wordfiles die ik er in wil verwerken, kunnen bestaan uit meerdere tabellen waartussen tekst staat.
Wat de macro nu doet, is de opmaak tussen de tabellen ook in celrand verwerken.

Zie nieuw voorbeeld. Dat was ook de reden waarom ik met voorwaardelijke opmaak werkte.
Zie je een mogelijkheid?Bekijk bijlage 311845Bekijk bijlage 311847
 
Ik ben eens in je macro gedoken, omdat ik naar mijn idee wel heel ingewikkeld moest doen om de juiste bepalingen te doen. Ik heb 'm sterk vereenvoudigd/ korter gemaakt. Ik weet echter niet of daarmee alles naar je zin is. Probeer maar. Even de sub hernoemen of de macro knop naar de macro Peter_B laten verwijzen.
Code:
Sub Peter_B()
    Rows("1:9").Delete Shift:=xlUp
    Columns("G:G").Delete Shift:=xlToLeft
    Columns("A:A").Delete Shift:=xlToLeft
    Columns("A:A").ColumnWidth = 19.14
    Columns("B:B").ColumnWidth = 22.29
    Columns("C:C").ColumnWidth = 20.86
    Columns("E:E").ColumnWidth = 15
    Columns("H:H").Copy
    Columns("E:E").PasteSpecial Paste:=xlPasteValues
    Columns("E:E").Style = "Currency"
    Range("I1").FormulaR1C1 = "=SUM(R[1]C:R[1767]C)"
    Range("K5:L5").FormulaR1C1 = "=R[-4]C[-2]"
    Range("K5:L5").Copy
    Range("K5:l5").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    With Columns("A:E")
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    i = 1
    While i < 1768
        If Cells(i, 1).Value = "Ref." Then
            With Range(Cells(i, 1), Cells(i, 1).End(xlDown)).Borders
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
        i = i + 1
    Wend
End Sub
 
Dag Peter,

De vereenvoudiging werkt en heb ik toegepast waarvoor dank.

Echter ik kan de file niet standaard inzetten. Nu werkt hij enkel voor de eerder toegevoegde Word.
Wanneer ik een andere Word toevoeg, heb ik terug problemen met de rand die doorgetrokken wordt waar het niet moet.

Zie nieuwe word en nieuwe excel waarin je code staat.

Ligt het aan het feit dat de tabel niet altijd even groot zal zijn in rijen?Bekijk bijlage 311937Bekijk bijlage 311939

2. Kan ik via een knop " Blanco" de situatie terugzetten zoals die was bij het openen van de Excel?
Dit om telkens opnieuw te kunnen beginnen met een andere offerte in plaats van telkens de file te sluiten en opnieuw te openen.

3. Kan ik ergens in de code gaan determineren wat mijn laatst ingevulde rij is?
Dit omdat ik onder die laatste tabel het totaal wil vermelden.
Ik moet dus via de laatste rij zoeken waar data in staat en moet eronder kunnen zeggen in kolom D " TOTAAL" en in kolom E: het bedrag berekend in I1
 
Vraag 2 en 3 zijn relatief eenvoudig te beantwoorden.

Vraag 2: Creëer een knop "Blanco". Kopieer handmatig de sheet (Blad1) in hetzelfde bestand en hernoem naar (bv) "Origineel". Hang de volgende code achter de knop "Blanco"
Code:
Sub TerugNaarAf()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("Blad1").Delete
    Application.DisplayAlerts = True
    Sheets("Origineel").Copy Before:=Sheets("Origineel")
    Sheets("Origineel (2)").Name = "Blad1"
    Application.ScreenUpdating = False
End Sub

Vraag 3: Zie mijn eerste code. De laatste rij wordt als volgt bepaald
Code:
With ThisWorkbook.Sheets(1)
    laatste_regel = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Voor vraag 3 geldt echter wel hetzelfde als voor vraag 1. Is de tabel in kolom A altijd tot de laatste regel gevuld? Mijn code gaat in je laatste voorbeeld nl. fout op het feit dat er ineens geen Ref. is ingevuld. Zo niet, welke kolom is wel altijd gevuld t/m de laatste regel?
 
Dag Peter,

1. TerugNaarAf werkt perfect. Ik probeer de code te begrijpen om ook in andere files toe te passen in de toekomst.
Begrijp ik het goed dat Blad1 wordt vervangen door Origineel waarbij de naam wordt gewijzigd naar Blad1 en dat Origineel wordt gekopieerd naar Origineel (2) waarna die opnieuw de naam Origineel krijgt en we dus terug in de startfase zijn.
Wat doen Application.ScreenUpdating en DisplayAlerts precies?

Sub TerugNaarAf()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Blad1").Delete
Application.DisplayAlerts = True
Sheets("Origineel").Copy Before:=Sheets("Origineel")
Sheets("Origineel (2)").Name = "Blad1"
Application.ScreenUpdating = False
End Sub

2. De kolommen die altijd ingevuld zullen zijn ( bij elk Worddoc ) zal de "Net/st" zijn.

Ik ben hier niet goed mee wat "i" is

i = 1
While i < 1768
If Cells(i, 1).Value = "Ref." Then
With Range(Cells(i, 1), Cells(i, 1).End(xlDown)).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
i = i + 1

3. Wanneer ik de laatste regel bepaald, hoe definieer ik dan in kolom D de toewijzing van het woord "TOTAAL" en in de cel ernaast kolom E het bedrag berekend in I1
 
Het is een goed gebruik om codes tussen tags te plaatsten. Dit kan met het "#". Hiermee wordt de CODE-tag aangezet.
Ook is het een goed gebruik om alleen indien nodig te quoten.

Antwoorden op je vragen:
1.
Het loopt echt op volgorde. Dus Blad1 wordt verwijderd, Origineel wordt gekopieerd (en wordt automatisch Origineel (2). Deze wordt hernoemd naar Blad1. Mogelijk kan dit laatste ook in één beweging (dus direct de juiste naam geven)
Application. ScreenUpdating = False zorgt dat het scherm in de tussentijd niet wordt refreshed. Dit voorkomt het flikkeren van het beeld. Ook is de code sneller
Application.DisplayAlerts = False zorgt dat je geen melding krijgt. Normaal krijg je bij het verwijderen van een tabblad een melding. Deze wordt hiermee onderdrukt

2.
Ik gebruik I als tellertje. In je originele code stond de waarde 1767, waarbij ik heb aangenomen dat dit het maximum aantal regels is. Met dit tellertje doorloop ik de rijen van 1 tot 1768 op zoek naar "Ref.". Als gevonden dan staat er een tabel waarbij de opmaak wordt gewijzigd. Wat je moet wijzigen is de volgende code naar de juiste kolom (kolom 5 bevat "Net/st":
Code:
With Range(Cells(i, 5), Cells(i, 5).End(xlDown)).Borders

3.
Het toewijzen kan met de functie Offset. Deze kun je gewoon achter je "zoek" plakken. Gebruik is Offset(Aantal rijen, Aantal kolommen). Of je bepaald de laatste regel met de volgende code (zoek laatste_regel en tel er 1 bij). Dus bv. (niet getest):
Code:
With ThisWorkbook.Sheets(1)
    laatste_regel = .Cells(.Rows.Count, "E").End(xlUp).Row
    .Cells(laatste_regel + 1, "D").Value = "TOTAAL"
    .Cells(laatste_regel + 1, "E").Value = .Cells(1, "I").Value
End With

<edit>
Ik zie trouwens dat ik 2 verschillende schrijfwijzes door elkaar heb gehanteerd. Je kunt bij Cells(rij, kolom) de kolom uitdrukken in getallen. Dus bv. kolom A = 1, kolom B =2. Je kunt ook de kolom letter gebruiken tussen quootjes. Dus "A", "B". Eigenlijk hanteer ik het liefst het laatste, maar omdat je daar niet mee kunt rekenen gebruik ik ook de getalnotatie ...
</edit>
 
Laatst bewerkt:
Bekijk bijlage 312835Dag Peter,

3. Totalen werkt wordt geplaatst in rij 1208. Hij neemt dus niet de laatste regel uit kolom D en E vermoed ik?
2. Ik heb de aanpassing gedaan zodat hij in "5" zoekt en dat werkt. Echter kom ik weer tot mijn initieele probleem, zijnde dat de border in de kolom Ref ( al dan niet leeg ) niet meer gemaakt wordt.

Zie nieuw bestand
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan