Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Office > PowerPoint

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 02-17-2012, 05:35 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default VBA and hyperlinks in table cells

Hi

I'm new to the whole powerpoint way of thinking, so my question may not be as precise as one could wish, but I hope that someone is able to help me anyway

I have created a link between excel and powerpoint where the VBA in powerpoint gets the content from excel and via some two dimensional arrays post the text in a table in powerpoint.

My problem is, that I need text in every single cell to be translated into a different hyperlink. I have tried to read about hyperlinks and VBA online, but I can't seem to get it to work with my code.




Thank you in advance
-Thomas

The place in the code where I need the hyperlink:

Code:
    Set pptPres = ActivePresentation
    With pptPres
        Set pptSlide = .Slides.Add(.Slides.Count, ppLayoutBlank)
    End With
    With pptSlide.Shapes
         Set pptShape = .AddTable(NumRows:=numberOfRows, NumColumns:=numberOfColumns, Left:=distanceFromLeft, _
                                Top:=distanceFromTop, Width:=tableWidth, Height:=tableHeight)
    End With
    With pptShape.Table
        For iRow = 1 To .Rows.Count
            For iColumn = 1 To .Columns.Count
                With .Cell(iRow, iColumn).Shape.TextFrame.TextRange
                    .Text = "Spørgsmål " & vbNewLine & questions(iColumn - 1, iRow - 1) & vbNewLine & "Svar " & vbNewLine & answers(iColumn - 1, iRow - 1)
                
                    With .Font
                       .Name = "Verdana"
                       .Size = "14"
                    End With
                End With
            Next iColumn
        Next iRow
    End With


Just in case - the entire code

Code:
Sub InsertTable()
'======= Setup for TABEL =========
    Dim pptSlide As Slide
    Dim pptShape As Shape
    Dim pptPres As Presentation
    Dim iRow As Integer
    Dim iColumn As Integer
    Dim oShapeInsideTable As Shape
    Dim numberOfColumns As Double
    Dim numberOfRows As Double
    Dim iCount_rows As Integer
    Dim iCount_columns As Integer
    
    
'======= Setup for EXCEL link =========
Dim sourceXL As Excel.Application
Dim sourceBook As Excel.Workbook
Dim sourceSheet As Excel.Worksheet
Dim dataReadArray(10) As String
Dim myPress As Presentation
Dim NewSlide As Slide
Dim Q As String
Dim A As String
Set sourceXL = Excel.Application
Set sourceBook = sourceXL.Workbooks.Open("H:\Documents\VBA\Excel_fil.xlsx")
Set sourceSheet = sourceBook.Sheets(1)
Set myPress = ActivePresentation
Set NewSlide = myPress.Slides.Add(Index:=myPress.Slides.Count + 1, Layout:=ppLayoutText)
   
'======= Data to construct the tabel =======
'======= page size = 720x510
 Dim tableHeight As Integer, tableWidth As Integer, distanceFromTop As Integer, distanceFromLeft As Integer
        
        numberOfColumns = 3
        numberOfRows = 5
        tableHeight = 350
        tableWidth = 660
        distanceFromTop = 100
        distanceFromLeft = 30
        
'====== Define Array to data from EXCEL ====='
ReDim questions(0 To numberOfColumns, 0 To numberOfRows) As String
ReDim answers(0 To numberOfColumns, 0 To numberOfRows) As String
Dim row_count As Integer
Dim row_count_char As String
iCount_rows = 0
iCount_columns = 0
row_count = 2   'start for tabel i EXCEL
 
' ===== array for questions =====
Do While iCount_columns < numberOfColumns
        Do While iCount_rows < numberOfRows
            row_count_char = "G" + LTrim(Str(row_count))
            questions(iCount_columns, iCount_rows) = sourceSheet.Range(row_count_char).Value
            iCount_rows = iCount_rows + 1
            row_count = row_count + 1
        Loop
    iCount_rows = 0
    iCount_columns = iCount_columns + 1
    
Loop
' ===== array for answers =====
iCount_rows = 0
iCount_columns = 0
row_count = 2   'start for tabel i EXCEL
        
Do While iCount_columns < numberOfColumns
        Do While iCount_rows < numberOfRows
            row_count_char = "H" + LTrim(Str(row_count))
            answers(iCount_columns, iCount_rows) = sourceSheet.Range(row_count_char).Value
            iCount_rows = iCount_rows + 1
            row_count = row_count + 1
        Loop
    iCount_rows = 0
    iCount_columns = iCount_columns + 1
    
Loop
        
        
' ===== building the table ===========
    Set pptPres = ActivePresentation
    With pptPres
        Set pptSlide = .Slides.Add(.Slides.Count, ppLayoutBlank)
    End With
    With pptSlide.Shapes
         Set pptShape = .AddTable(NumRows:=numberOfRows, NumColumns:=numberOfColumns, Left:=distanceFromLeft, _
                                Top:=distanceFromTop, Width:=tableWidth, Height:=tableHeight)
    End With
    With pptShape.Table
        For iRow = 1 To .Rows.Count
            For iColumn = 1 To .Columns.Count
                With .Cell(iRow, iColumn).Shape.TextFrame.TextRange
                    .Text = "Spørgsmål " & vbNewLine & questions(iColumn - 1, iRow - 1) & vbNewLine & "Svar " & vbNewLine & answers(iColumn - 1, iRow - 1)
                
                    With .Font
                       .Name = "Verdana"
                       .Size = "14"
                    End With
                End With
            Next iColumn
        Next iRow
    End With
    
    With pptShape.Table
        ' Insert a row at the top of the table and set it's height
        .Rows.Add BeforeRow:=1
        .Rows(1).Height = 30
        Set oShapeInsideTable = .Cell(1, 1).Shape
        With oShapeInsideTable
            With .TextFrame.TextRange
                .Text = "Kategori"
                .ParagraphFormat.Alignment = ppAlignCenter
            End With
        End With
    End With
End Sub
Reply With Quote
  #2  
Old 02-17-2012, 05:38 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default Ups - wrong code

Unfortunately the code was copied in the wrong way underlining my newbee status I hope it is better now?

Last edited by viuf; 02-17-2012 at 05:42 AM. Reason: wrong code
Reply With Quote
  #3  
Old 02-17-2012, 06:45 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Where do you have the hyperlink addresses stored?
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #4  
Old 02-17-2012, 07:34 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

Hi

There is no hyperlinks at the moment - only text. The hyperlink is going to created on basis of the text in the different fields.

What I need is a way to substitute the text with hyperlink. For the time being it can just be a "fake" hyperlink.

Hope it makes sense?!

Thomas
Reply With Quote
  #5  
Old 02-17-2012, 08:51 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Not really. You cannot create a hyperlink without a target address and there's no sign of a suitable address anywhere.
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #6  
Old 02-17-2012, 11:51 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

Ah ok...

What I need is the hyperlink (or maybe som other kind of action if that will be smarter) in each cell to activate another macro (that has not been build yet). But something where the link (or action-something) activates a sub while sending along the value for "questions" and "answers" .

The different values for the "answers" and "questions" are stored in the arrays with the same name.

**** example sub: ****

sub new_slide(question as string, answer as string)
... generating a new slide and placing the "answer" and "question" in two separate textboxes.
end sub

Thanks...
Reply With Quote
  #7  
Old 02-19-2012, 02:51 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Something like this maybe:

Code:
  With .Cell(iRow, iColumn).Shape.TextFrame.TextRange
                .Text = "Spørgsmål " & vbNewLine & questions(iColumn - 1, iRow - 1) & vbNewLine & "Svar " & vbNewLine & answers(iColumn - 1, iRow - 1)
                With .Font
                   .Name = "Verdana"
                   .Size = "14"
                End With
                With .ActionSettings(ppMouseClick)
                If iRow = 1 And iColumn = 1 Then
                .Action = ppActionRunMacro
                .Run = "myMacro"
                End If
                End With
            End With
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #8  
Old 02-19-2012, 05:34 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

Simpel and yet exactely what I was looking for. Thank you

In addition to that I have to related questions that I hope you (or other) can help me with.

1. How can I format the look of these links so they are not just blue and underlined?


2. How do I send a variable with the link to the new sub?

What I mean is if I remove the IF-part so I get a link in every cell, how can I make each link differet? iRow changes for every cell, so I would like this variable to be send to the next sub, depending on wich cell is pressed, and the value used there.

Code:
                With .ActionSettings(ppMouseClick)
                .Action = ppActionRunMacro
                .Run = "GoToSlide(iRow)"
                End with

 
Sub GoToSlide(page as integer)
    ActivePresentation.SlideShowWindow.View.GoToSlide (page)
End Sub
the GoToSlide sub is not what I'm going to use later, just to get an idea of how to re-use the variables.

Thanks again
Reply With Quote
  #9  
Old 02-19-2012, 07:27 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

You can only pass a single object variable using the .Run method and it always equals the shape clicked. In your case the shape will be the whole table so not very useful. I think you will need a seperate macro for each cell/
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #10  
Old 02-19-2012, 07:41 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

hmmm... that is bad news for my work.

Is there any other way than .Run to have a different link in each cell without having to create 30 or so macros?
Reply With Quote
  #11  
Old 02-19-2012, 08:32 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

The ONLY way I can see would be not to link to the text but add a transparent rectangle over each cell (with code of course) and link to this. It would be possible to pass the name of the shape to the macro and use this to differentiate. This would also get rid of the blue underline text BUT it's not simple coding. You would need to use the left,top, width, and height of each cell and set the fill transparency to 1 and the line to not visible and then add a name and link.
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #12  
Old 02-19-2012, 09:51 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

Ok, that's not good

I have now tried to do some shapes instead because the table is not the important thing, but I still have the same problem with the links. How kan I pass through a value to the GoToSlide sub?

Code:
Sub addShape()
 
Dim oshp As Shape
Dim height As Integer, width As Integer, left As Integer, right As Integer
Dim countOne As Integer, countTwo As Integer

height = 50
width = 80
left = 20
Top = 20
countOne = 0
countTwo = 0
Do While countOne < 3
Set oshp = ActivePresentation.Slides(2).Shapes _
.addShape(msoShapeRectangle, left, Top + (countOne * (height + 10)), width, height) ' left, top, width, height
    With oshp
        .Name = "myshape" & countOne
    End With
    With oshp.TextFrame.TextRange
        .Text = "Kategori" & countOne
    End With
    With oshp.ActionSettings(ppMouseClick)
        .Action = ppActionRunMacro
        .Run = "GoToSlide"
    End With
countOne = countOne + 1
Loop
End Sub
 

Sub GoToSlide()
    ActivePresentation.SlideShowWindow.View.GoToSlide (1)
End Sub
Reply With Quote
  #13  
Old 02-19-2012, 10:22 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

If you name your shapes "1", "2" whatever you can pass the name if the macro resembles

Code:
Sub test(oshp As Shape)
Dim L As Long
L = CLng(oshp.Name)
MsgBox "Ten times " & L & "is " & 10 * L
End Sub
Obviously this is a very simple example but you should be able to pass any value in this way. You link would just call "test" or whatever you call the macro.
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #14  
Old 02-19-2012, 10:34 AM
viuf viuf is offline Windows XP Office 2007
Novice
 
Join Date: Feb 2012
Posts: 10
viuf is on a distinguished road
Default

Absolutly perfect! Thank you John for all your help
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Word VBA: add textboxs in table cells? tinfanide Word VBA 12 02-09-2012 12:05 AM
put a border around table cells that have text in them tonywatsonmail Mail Merge 1 01-31-2012 04:37 AM
Unwanted tabs in table cells deltaskye Word 5 01-27-2012 11:58 AM
Combining Text from Table Cells robmorleyuk Word 1 11-01-2011 07:24 AM
Word with frames, table of contents, and hyperlinks to html NHMC Word Tables 0 12-09-2009 12:54 PM


All times are GMT -7. The time now is 07:44 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft