• 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.

Geselecteerde cellen verwijzing

Status
Niet open voor verdere reacties.
de cellen die erachter komen moeten niet hetzelfde aantal rondjes hebben
Klik om te vergroten...
maar dat doet de code juist niet. er komen naar gelang je in je userform getallen hebt ingevuld rondjes in de corresponderende cellen. Alleen de ceode is geent op het hebben van niet aan elkaar gekoppelde cellen. Hiervoor moet je je offset veranderen naar het aantal cellen wa wel klopt, even proberen.

Natuurlijk mag je je file prive doorsturen, maar denk dat als je deze code gebruikt en iets meer aanpast aan je maatstaven er zelf al uit kan komen :D .
 
Heb er eens een foto van gemaakt. Hij zet ze allemaal in de dezelfde cel, en ik geraak er niet echt aan uit wat ik moet aanpassen :)

demeteraz5.jpg


Code: 
Private Sub CommandButton1_Click()

    If Not Intersect(ActiveCell, Range("G:G")) Is Nothing Then
        ActiveCell = Rondjes_maken(Me.kaderstijl.Value)
        ActiveCell.offset(, 1) = Rondjes_maken(Me.kaderregel.Value)
        ActiveCell.offset(, 2) = Rondjes_maken(Me.vleugelstijl.Value)
        ActiveCell.offset(, 3) = Rondjes_maken(Me.vleugelregel.Value)
    End If

    UserForm7.Hide

End Sub

Function Rondjes_maken(aantal_rondjes As Long)
  
    If aantal_rondjes > 0 And aantal_rondjes < 5 Then
        Select Case aantal_rondjes
            Case 1
                 Rondjes_maken = ActiveSheet.Pictures.Insert( _
     "C:\Documents and Settings\Mati\Bureaublad\Ronde1.bmp" _
     ).Select

    Selection.ShapeRange.IncrementLeft 19
    Selection.ShapeRange.IncrementTop 1.5
   
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop 0.75
            Case 2
...

Ik veronderstel dat het probleem ligt bijd e verwijzing naar cel G niet ?


Mvg
 
Laatst bewerkt:
Hier liggen volgens mij de problemen:

Code: 
    Selection.ShapeRange.IncrementLeft 19
    Selection.ShapeRange.IncrementTop 1.5
   
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop 0.75

al kan ik niet zeggen wat het dan zou moeten zijn.
 
Die gaat de foto gewoon verkleinen en wat centreren hé Wigi.

Ik heb ze eens uitgezet, maar het veranderde jammergenoeg niks :)
 
Laatst bewerkt:
Probeer deze code eens:
Code: 
Sub CommandButton1_Click()
Dim s As Shape

'pad naar de plaatjes
pad = "C:\Excel\"

'naam van de plaatjes
'rondje1.bmp, rondje2.bmp, rondje3 en rondje4.bmp

        With ActiveCell
            Set s = .Parent.Shapes.AddPicture(pad & "rondje" & Me.kaderstijl.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
                'Hiermee kan je de schaal van je plaatje nog aanpassen
                'With s
                '    .ScaleHeight 0.5, msoTrue
                '    .ScaleWidth 0.5, msoTrue
                'End With
                'hiermee verplaats je de locatie van je plaatje in je cel.
                'With s
                '    .IncrementLeft 19
                '    .IncrementTop 1.5
                'End With
        End With
        
        With ActiveCell.Offset(, 1)
            Set s = .Parent.Shapes.AddPicture(pad & "rondje" & Me.kaderregel.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
        End With
        
        With ActiveCell.Offset(, 2)
            Set s = .Parent.Shapes.AddPicture(pad & "rondje" & Me.vleugelstijl.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
        End With
        
        With ActiveCell.Offset(, 3)
            Set s = .Parent.Shapes.AddPicture(pad & "rondje" & Me.vleugelregel.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
        End With

Me.Hide

End Sub
 
Laatst bewerkt:
Alvast bedankt.

Bij het pad probeer ik

pad ="C:\Documents and Settings\VanGans\Bureaublad\.bmp" _
).Select

"C:\Documents and Settings\VanGans\Bureaublad\Ronde1.bmp" _
).Select

Maar blijkbaar heeft hij hier moeite mee.

Mijn naamplaatjes komen voorlopig ook in het rood.

'naam van de plaatjes
Ronde1.bmp, Ronde2.bmp, Ronde3 en Ronde4.bmp




Aanpassing: het pad staat nu niet meer in het rood enkel de naam van de plaatjes heeft hij het moeilijk mee.

Intern heb ik de naam van rondje al aangepast naar ronde

helpmijho3.jpg
 
Laatst bewerkt:
pad = het pad naar je plaatjes. In jou geval:
pad = C:\Documents and Settings\VanGans\Bureaublad\

naam van de plaatjes heb ik gegeven zodat jij kan herleiden war je de namen voor jouw plaatjes moet veranderen.

verander het rode gedeelte (door de gehele code) in jouw plaatjes naam welke voor het nummer staat.In jouw geval ronde
Code: 
Set s = .Parent.Shapes.AddPicture(pad & "[COLOR="Red"]rondje[/COLOR]" & Me.kaderstijl.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
Als je een ander type plaatje gebruikt dan zal je ook de .bmp extensie moeten wijzigen.
 
Ik vrees dat ik niet echt mee ben.

Mijn pad is nu : " C:\Documents and Settings\VanGans\Bureaublad\"

Het rode heb ik al aangepast Demeter

Code: 
With ActiveCell.offset(, 1)
            Set s = .Parent.Shapes.AddPicture(pad & "ronde" & Me.kaderregel.Value & ".bmp", True, True, .Left, .Top, .Width, .Height)
        End With

Demeter, u hebt mail :D hoop ik ...
 
Laatst bewerkt:
Vangans,

Mijn Excel loopt geheel vast door uw bestand. Ligt denk ik aan mijn pc, is al twee dagen zo traag als st$%#@.

Kijk even naar deze file.
Onzippen naar de c: schijf.

Verander enkel:
Code: 
'pad naar de plaatjes
pad = "C:\excel\"
'naam van de plaatjes voor het cijfer, bijv. rond ipv rond1.bmp
naamplaatje = "rondje"
'extensie van het plaatje + de voorloop .
extensieplaatje = ".bmp"

Ga zo eens even mijn gehele pc opnieuw installeren.
Wordt er bijkans niet goed meer van.

Succes.
Kijk vanavond nog wel even naar uwen file.
 

Bijlagen

Dat kennen we allemaal wel een beetje zeker, hier idem.

Ik ga eens proberen maar ik vrees ervoor.

Tot dan en alvast bedankt
 
Voor degene welke deze post volgen of willen op zoek zijn naar een code voor het plaatsen van een plaatje in een cel.

Zet deze code achter de UserFrom7 vanuit een eerdere post.
Code: 
Sub CommandButton1_Click()
Dim s As Shape
Dim pad, naamplaatje, extensieplaatje As String

'pad naar de plaatjes
pad = "C:\excel\ "
'naam van de plaatjes voor het cijfer, bijv. rond ipv rond1.bmp
naamplaatje = "rondje"
'extensie van het plaatje + de voorloop .
extensieplaatje = ".bmp"

    'controleer of alle velden zijn ingevuld
    If Me.kaderstijl.Value <> "" And Me.kaderregel.Value <> "" And Me.vleugelstijl.Value <> "" And Me.vleugelregel.Value <> "" Then
        With ActiveCell
            Set s = .Parent.Shapes.AddPicture(pad & naamplaatje & Me.kaderstijl.Value & extensieplaatje, True, True, .Left, .Top, .Width, .Height)
                With s
                    'Hiermee kan je de schaal van je plaatje nog aanpassen
                    'staat nu op 1x vergroten, kan bijvoorbeeld ook 0.9 of 1.1 worden (kleiner of groter)
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                    'hiermee verplaats je de locatie van je plaatje in je cel.
                    .IncrementLeft 1
                    .IncrementTop 1
                End With
        End With
        
        With ActiveCell.Offset(, 1)
            Set s = .Parent.Shapes.AddPicture(pad & naamplaatje & Me.kaderregel.Value & extensieplaatje, True, True, .Left, .Top, .Width, .Height)
                With s
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                    .IncrementLeft 1
                    .IncrementTop 1
                End With
        End With
        
        With ActiveCell.Offset(, 2)
            Set s = .Parent.Shapes.AddPicture(pad & naamplaatje & Me.vleugelstijl.Value & extensieplaatje, True, True, .Left, .Top, .Width, .Height)
                With s
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                    .IncrementLeft 1
                    .IncrementTop 1
                End With
        End With
        
        With ActiveCell.Offset(, 4)
            Set s = .Parent.Shapes.AddPicture(pad & naamplaatje & Me.vleugelregel.Value & extensieplaatje, True, True, .Left, .Top, .Width, .Height)
                With s
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                    .IncrementLeft 1
                    .IncrementTop 1
                End With
        End With
    Else
        MsgBox "Vul alle gegevens juist in?"
    End If
        
    Unload Me

End Sub



Private Sub UserForm_Activate()

    'controleer of er wel een cel geselecteerd is in kolom G onder een cel met de tekst Kader Stijlen
    'let op!!! in sommige cellen had jij en spatie achter Stijlen staan, hierdoor werkt de controle niet
    'VBA kijkt puur naar het aantal juiste tekens.
    If Intersect(ActiveCell, Range("G:G")) Is Nothing Or ActiveCell.Offset(-1) <> "Kader Stijlen" Then
        MsgBox "Selecteer een cel in kolom G onder een cel met de tekst: Kader Stijlen?"
        Me.Hide
    End If
        
End Sub
 
Laatst bewerkt:
Mati,

Zie je email.
Hierin staat dezelfde code als hierboven alleen in jouw "prive"file.

ps.
Misschien kan je de vraagstelling wat veranderen zodat andere mensen dit topic makkelijker kunnen vinden?
 
Laatst bewerkt:
DeMeter, alvast hartelijk bedankt, het werkt idd en ik snap het nog ook. :thumb:

Mooi werk, bedankt.

Voor de mensen die opzoek zijn naar dergelijke topic zet ik hier enkele zoek woorden neer.

De topictitel kan ik namelijk niet aanpassen.

Plaatje invoegen
Foto invoegen
Picture
Foto vergroten
Foto verkleinen

Mvg
VanGans
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan