![]() |
#1
|
|||
|
|||
![]()
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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
tinfanide | Word VBA | 12 | 02-09-2012 12:05 AM |
![]() |
tonywatsonmail | Mail Merge | 1 | 01-31-2012 04:37 AM |
![]() |
deltaskye | Word | 5 | 01-27-2012 11:58 AM |
![]() |
robmorleyuk | Word | 1 | 11-01-2011 07:24 AM |
Word with frames, table of contents, and hyperlinks to html | NHMC | Word | 0 | 12-09-2009 12:54 PM |