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

Waar zitten de foto's verstopt?

Status
Niet open voor verdere reacties.
N

nieuwene

Gebruiker
Lid geworden
13 nov 2009
Berichten
17
Beste mensen,

In de bijlage vinden jullie een excel sheet, waarmee je (in dit geval) je favoriete vrouw kan kiezen. Omdat de foto's verouderd zijn, wil ik deze graag vernieuwen, maar ik kan nergens vinden waar ik deze foto's kan vervangen (nee, en ook niet nadat ik zelf van alles heb geprobeerd.....).

Kan iemand vertellen waar de foto's verstopt zitten en hoe ik deze kan vervangen?

Alvast bedankt!
 
Nou heb ik mijn favoriete vrouw al gevonden, maar jouw bijlage nog niet . . .
 
Probleem is dat het bestand te groot is....
Iemand een idee hoe ik het bestand dan met jullie kan delen?
 
nieuwene zei:
Probleem is dat het bestand te groot is....
Iemand een idee hoe ik het bestand dan met jullie kan delen?
Klik om te vergroten...

Is dat een foto kalender in excel ? waar iedere maand een nieuwe vrouw tevoorschijn komt ? anders Danny 147 weet die zitten in het verborgen tabblad eens klikken op de tabs onderaan en daar de verborgen tabbladen zichtbaar maken :rolleyes: misschien dat dit kan helpen ;)
 
Ik heb alle verborgen bestanden al zichtbaar gemaakt, maar ik zie geen foto's.
Als ik kijk in VB dan zie ik dat er dingen gebeuren met "shapes", maar ik begrijp niet hoe of wat.

Hieronder volgt de code:

Code: 
Option Explicit
Const BWidth = 4
Sub who_wins()
Dim txt As String
    txt = Worksheets("game").Shapes(Application.Caller).DrawingObject.Text
    txt = Left(txt, Len(txt) - 5)
    Worksheets("Match").Unprotect
    Worksheets("Match").Cells(Worksheets("DATA").Cells(2, 1), Worksheets("DATA").Cells(3, 1)) = txt
    Worksheets("Match").Protect
    ActiveWindow.DisplayVerticalScrollBar = True
    ActiveWindow.DisplayHorizontalScrollBar = True
    Worksheets("Game").Visible = False
    If Selection.Address = "$H$26" Then
        Call show_winner(txt)
        Call update_league
    End If
End Sub
Sub show_winner(winner As String)
        Worksheets("Game").Shapes(winner).CopyPicture
        Worksheets("match").Unprotect
        Worksheets("match").Paste
        Selection.Name = "winner"
            Worksheets("match").Shapes("winner").Width = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Height - BWidth) / Worksheets("match").Shapes("winner").Height
            Worksheets("match").Shapes("winner").Height = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Height - BWidth) / Worksheets("match").Shapes("winner").Height
            If Worksheets("match").Shapes("winner").Width > Worksheets("match").Shapes("winnerFrame").Width Then
                Worksheets("match").Shapes("winner").Height = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Width - BWidth) / Worksheets("match").Shapes("winner").Width
                Worksheets("match").Shapes("winner").Width = Worksheets("match").Shapes("winner").Width * (Worksheets("match").Shapes("winnerFrame").Width - BWidth) / Worksheets("match").Shapes("winner").Width
            End If
            Worksheets("match").Shapes("winner").Top = Worksheets("match").Shapes("winnerFrame").Top + (Worksheets("match").Shapes("winnerFrame").Height - Worksheets("match").Shapes("winner").Height) / 2
            Worksheets("match").Shapes("winner").Left = Worksheets("match").Shapes("winnerFrame").Left + (Worksheets("match").Shapes("winnerFrame").Width - Worksheets("match").Shapes("winner").Width) / 2
        Worksheets("match").Protect
End Sub
Sub update_league()
Dim r As Long, c As Long, i As Integer
    For r = 9 To 57
        For c = 5 To 11
            If Not Worksheets("match").Cells(r, c).Value = "" Then
                For i = 1 To 64
                    If Worksheets("data").Cells(i, 7).Value = Worksheets("match").Cells(r, c).Value Then Worksheets("data").Cells(i, 8).Value = Worksheets("data").Cells(i, 8).Value + 1
                Next i
            End If
        Next c
    Next r
    Worksheets("DATA").Cells(1, 1).Value = Worksheets("DATA").Cells(1, 1).Value + 1
    Call Worksheets("DATA").Range("g1:h64").Sort(Worksheets("DATA").Range("h1"), xlDescending)
    Worksheets("match").Unprotect
    Worksheets("match").Shapes("LeagueTitle").DrawingObject.Text = "LEAGUE TABLE AFTER GAME " & Worksheets("DATA").Cells(1, 1).Value
    Worksheets("match").Shapes("LeagueName").DrawingObject.Text = Worksheets("DATA").Cells(1, 7) & Chr(10) & Worksheets("DATA").Cells(2, 7) & Chr(10) & Worksheets("DATA").Cells(3, 7) & Chr(10) & Worksheets("DATA").Cells(4, 7) & Chr(10) & Worksheets("DATA").Cells(5, 7)
    Worksheets("match").Shapes("LeaguePoints").DrawingObject.Text = Worksheets("DATA").Cells(1, 8) & Chr(10) & Worksheets("DATA").Cells(2, 8) & Chr(10) & Worksheets("DATA").Cells(3, 8) & Chr(10) & Worksheets("DATA").Cells(4, 8) & Chr(10) & Worksheets("DATA").Cells(5, 8)
    Worksheets("match").Protect
    If Worksheets("DATA").Cells(1, 1).Value = 1 Then
        Open ActiveWorkbook.Path & "\LEAGUE.TXT" For Output As #1
        For i = 1 To 8
            Print #1, Worksheets("data").Cells(i, 7).Value; Tab; Worksheets("data").Cells(i, 8).Value
        Next i
        Close #1
    End If
End Sub


Is het voor jullie experts mogelijk om aan de hand van deze code te vertellen hoe ik de foto's kan benaderen?
 
Laatst bewerkt door een moderator:
Ik heb worksheet "Game" helemaal doorzocht, maar ik kan niets vinden.....
Misschien een minder slimme vraag, maar hoe kan die shapes bekijken/vinden?
 
Beste trucker10

trucker10 zei:
Is dat een foto kalender in excel ? waar iedere maand een nieuwe vrouw tevoorschijn komt ? anders Danny 147 weet die zitten in het verborgen tabblad eens klikken op de tabs onderaan en daar de verborgen tabbladen zichtbaar maken :rolleyes: misschien dat dit kan helpen ;)
Klik om te vergroten...

Wat bedoel je hiermee ? :D

Anders ga eens naar mijn site en kijk eens bij Ero- kalender :thumb:

Groetjes Danny. :thumb:
 
nieuwene zei:
Ik heb worksheet "Game" helemaal doorzocht, maar ik kan niets vinden.....
Misschien een minder slimme vraag, maar hoe kan die shapes bekijken/vinden?
Klik om te vergroten...

Doe een rechterklik op de tab van dit werkblad maak een kopie naar een ander nieuw werkblad en load dit up , weg zullen dan eens kijken of het werkelijk zo is dat er geen verborgen rijen kolommen in die sheet zitten waar de foto's achter zitten
 
Het advies van trucker10 en danny147 hebben helaas ook niet geholpen.

Heeft iemand nog suggesties?

Of kan ik het bestand naar iemand mailen, zodat iemand kan meekijken?
 
nieuwene zei:
Het advies van trucker10 en danny147 hebben helaas ook niet geholpen.

Heeft iemand nog suggesties?

Of kan ik het bestand naar iemand mailen, zodat iemand kan meekijken?
Klik om te vergroten...

Heb je #11 gelezen , maak een kopie van dat tabblad en zet dit hier dan op het forum
Je doet een rechtermuisklik op de tab van dat blad , dan kies je voor " blad verplaatsen of kopiëren , daar kies je voor kopie maken en selecteer bij " naar map " > nieuwe map .
 
Beste nieuwene ;)

nieuwene zei:
Het advies van trucker10 en danny147 hebben helaas ook niet geholpen.

Heeft iemand nog suggesties?

Of kan ik het bestand naar iemand mailen, zodat iemand kan meekijken?
Klik om te vergroten...

Ik wil wel een poging wagen.
Mijn e-mail adres staat bij mijn gegevens of op mijn site.

Groetjes Danny. :thumb:
 
Run deze macro op Blad "Game".

Code: 
Sub tst()
    Dim Sh      As Shape
    For Each Sh In ActiveSheet.Shapes
        Sh.Visible = True
    Next
End Sub
 
Beste nieuwene ;)

Heb bestandje ontvangen.

Ga naar OPTIES en klik op TABBLADS weergeven.
Dan de verborgen tabbladen weergeven en je hebt het.

Dan zie je 3 tabbladen GAME, MATCH en DATA.

Groetjes Danny. :thumb:
 
Beste Danny , volgens TS waren er geen :p zie #6
Ik heb alle verborgen bestanden al zichtbaar gemaakt, maar ik zie geen foto's.
Klik om te vergroten...
Dan hebben we hem verwezen naar tabblad " game " die in de macrocode staat
Quote:
Origineel gepost door trucker10
Ik zou ze in de sheet " game" gaan zoeken

Getuige o.a.:
Code:
Worksheets("Game").Shapes(winner).CopyPicture__________________
Klik om te vergroten...
gepost door Wigi .
Alvast je hebt de TS geholpen :thumb:
 
Beste Trucker 10 ;)

Foto's ook niet gevonden :(

Hierbij alle codes die er instaan.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Target.Count > 1 Then Exit Sub
    If Not Target = "" Then Exit Sub
    If Not Target.Interior.Color = 13434828 Then Exit Sub
    Worksheets("DATA").Cells(2, 1) = Target.Row
    Worksheets("DATA").Cells(3, 1) = Target.Column
    If Target.Column < 8 Then
        Call Play_Match(Cells(Target.Row - 2 ^ (Target.Column - 3), Target.Column - 1), Cells(Target.Row + 2 ^ (Target.Column - 3), Target.Column - 1))
    ElseIf Target.Column > 8 Then
        Call Play_Match(Cells(Target.Row - 2 ^ (13 - Target.Column), Target.Column + 1), Cells(Target.Row + 2 ^ (13 - Target.Column), Target.Column + 1))
    Else
        Call Play_Match(Cells(33, 7), Cells(33, 9))
    End If
End Sub

Code: 
Sub New_game()
Dim i As Integer
    Worksheets("match").Unprotect
    For i = Worksheets("Match").Shapes.Count To 1 Step -1
        If Worksheets("match").Shapes(i).Name = "winner" Then Worksheets("match").Shapes(i).Delete
    Next i
    Worksheets("match").Range(Cells(2, 3), Cells(64, 13)).ClearContents
    Worksheets("match").Protect
    For i = 1 To 64
        Worksheets("DATA").Cells(i, 4).Value = Rnd
    Next i
    Worksheets("DATA").Range("c1:d64").Sort (Worksheets("DATA").Range("d1"))
End Sub

Code: 
Sub Play_Match(PlayerLeft As String, PlayerRight As String)
Dim i As Integer
    If PlayerLeft = "" Or PlayerRight = "" Then Exit Sub
    For i = 1 To Worksheets("Game").Shapes.Count
        If Not (Worksheets("Game").Shapes(i).Name = "LeftButton" Or Worksheets("Game").Shapes(i).Name = "RightButton") Then
            Worksheets("Game").Shapes(i).Visible = False
        End If
    Next i
    ActiveWindow.DisplayVerticalScrollBar = False
    ActiveWindow.DisplayHorizontalScrollBar = False
    With Worksheets("Game")
        .Unprotect
        .Shapes("LeftButton").DrawingObject.Text = PlayerLeft & " wins"
        .Shapes("RightButton").DrawingObject.Text = PlayerRight & " wins"
        .Shapes("Port").Top = (.Range("a1:h17").Height - .Shapes("Port").Height) / 2
        .Shapes(PlayerLeft).Top = (.Range("a1:h17").Height - .Shapes(PlayerLeft).Height) / 2
        .Shapes(PlayerRight).Top = (.Range("a1:h17").Height - .Shapes(PlayerRight).Height) / 2
        .Shapes("Stbd").Top = (.Range("a1:h17").Height - .Shapes("Stbd").Height) / 2
        .Shapes("Port").Left = (.Range("a1:h17").Width / 2 - .Shapes("Port").Width) / 2
        .Shapes(PlayerLeft).Left = (.Range("a1:h17").Width / 2 - .Shapes(PlayerLeft).Width) / 2
        .Shapes(PlayerRight).Left = (.Range("a1:h17").Width / 2 - .Shapes(PlayerRight).Width) / 2 + .Range("a1:h17").Width / 2
        .Shapes("Stbd").Left = (.Range("a1:h17").Width / 2 - .Shapes("Stbd").Width) / 2 + .Range("a1:h17").Width / 2
        .Shapes("Port").Visible = True
        .Shapes(PlayerLeft).Visible = True
        .Shapes(PlayerRight).Visible = True
        .Shapes("Stbd").Visible = True
        .Visible = True
        .Select
        .Range(.Cells(1, 1), .Cells(17, 8)).Select
        ActiveWindow.Zoom = True
        .Cells(5, 3).Select
        .Protect
    End With
End Sub

Code: 
Sub reset_league()
    Worksheets("DATA").Cells(1, 1).ClearContents
    Worksheets("DATA").Range(Worksheets("DATA").Cells(1, 8), Worksheets("DATA").Cells(64, 8)).ClearContents
    Worksheets("match").Unprotect
    Worksheets("match").Shapes("LeagueTitle").DrawingObject.Text = "LEAGUE TABLE"
    Worksheets("match").Shapes("LeagueName").DrawingObject.Text = ""
    Worksheets("match").Shapes("LeaguePoints").DrawingObject.Text = ""
    Worksheets("match").Protect
End Sub

Code: 
Const BWidth = 4
Sub who_wins()
Dim txt As String
    txt = Worksheets("game").Shapes(Application.Caller).DrawingObject.Text
    txt = Left(txt, Len(txt) - 5)
    Worksheets("Match").Unprotect
    Worksheets("Match").Cells(Worksheets("DATA").Cells(2, 1), Worksheets("DATA").Cells(3, 1)) = txt
    Worksheets("Match").Protect
    ActiveWindow.DisplayVerticalScrollBar = True
    ActiveWindow.DisplayHorizontalScrollBar = True
    Worksheets("Game").Visible = False
    If Selection.Address = "$H$26" Then
        Call show_winner(txt)
        Call update_league
    End If
End Sub
Sub show_winner(winner As String)
        Worksheets("Game").Shapes(winner).CopyPicture
        Worksheets("match").Unprotect
        Worksheets("match").Paste
        Selection.Name = "winner"
            Worksheets("match").Shapes("winner").Width = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Height - BWidth) / Worksheets("match").Shapes("winner").Height
            Worksheets("match").Shapes("winner").Height = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Height - BWidth) / Worksheets("match").Shapes("winner").Height
            If Worksheets("match").Shapes("winner").Width > Worksheets("match").Shapes("winnerFrame").Width Then
                Worksheets("match").Shapes("winner").Height = Worksheets("match").Shapes("winner").Height * (Worksheets("match").Shapes("winnerFrame").Width - BWidth) / Worksheets("match").Shapes("winner").Width
                Worksheets("match").Shapes("winner").Width = Worksheets("match").Shapes("winner").Width * (Worksheets("match").Shapes("winnerFrame").Width - BWidth) / Worksheets("match").Shapes("winner").Width
            End If
            Worksheets("match").Shapes("winner").Top = Worksheets("match").Shapes("winnerFrame").Top + (Worksheets("match").Shapes("winnerFrame").Height - Worksheets("match").Shapes("winner").Height) / 2
            Worksheets("match").Shapes("winner").Left = Worksheets("match").Shapes("winnerFrame").Left + (Worksheets("match").Shapes("winnerFrame").Width - Worksheets("match").Shapes("winner").Width) / 2
        Worksheets("match").Protect
End Sub
Sub update_league()
Dim r As Long, c As Long, i As Integer
    For r = 9 To 57
        For c = 5 To 11
            If Not Worksheets("match").Cells(r, c).Value = "" Then
                For i = 1 To 64
                    If Worksheets("data").Cells(i, 7).Value = Worksheets("match").Cells(r, c).Value Then Worksheets("data").Cells(i, 8).Value = Worksheets("data").Cells(i, 8).Value + 1
                Next i
            End If
        Next c
    Next r
    Worksheets("DATA").Cells(1, 1).Value = Worksheets("DATA").Cells(1, 1).Value + 1
    Call Worksheets("DATA").Range("g1:h64").Sort(Worksheets("DATA").Range("h1"), xlDescending)
    Worksheets("match").Unprotect
    Worksheets("match").Shapes("LeagueTitle").DrawingObject.Text = "LEAGUE TABLE AFTER GAME " & Worksheets("DATA").Cells(1, 1).Value
    Worksheets("match").Shapes("LeagueName").DrawingObject.Text = Worksheets("DATA").Cells(1, 7) & Chr(10) & Worksheets("DATA").Cells(2, 7) & Chr(10) & Worksheets("DATA").Cells(3, 7) & Chr(10) & Worksheets("DATA").Cells(4, 7) & Chr(10) & Worksheets("DATA").Cells(5, 7)
    Worksheets("match").Shapes("LeaguePoints").DrawingObject.Text = Worksheets("DATA").Cells(1, 8) & Chr(10) & Worksheets("DATA").Cells(2, 8) & Chr(10) & Worksheets("DATA").Cells(3, 8) & Chr(10) & Worksheets("DATA").Cells(4, 8) & Chr(10) & Worksheets("DATA").Cells(5, 8)
    Worksheets("match").Protect
    If Worksheets("DATA").Cells(1, 1).Value = 1 Then
        Open ActiveWorkbook.Path & "\LEAGUE.TXT" For Output As #1
        For i = 1 To 8
            Print #1, Worksheets("data").Cells(i, 7).Value; Tab; Worksheets("data").Cells(i, 8).Value
        Next i
        Close #1
    End If
End Sub

Als iemand van jullie weet waar de foto's zich bevinden is TS geholpen.

Groetjes Danny. :thumb:
 
LucB zei:
Run deze macro op Blad "Game".

Code: 
Sub tst()
    Dim Sh      As Shape
    For Each Sh In ActiveSheet.Shapes
        Sh.Visible = True
    Next
End Sub
Klik om te vergroten...
:thumb: Ik denk dat dat zal helpen, aangezien ik deze regel zie staan in de code:
Code: 
Worksheets("Game").Shapes(i).Visible = False
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan