Announcement

Collapse
No announcement yet.

Creating Excel documents with Hyperlinks

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Creating Excel documents with Hyperlinks


    I have been trying to import data into an excel report and format particular cells as hyperlinks .

    The first two lines of code bring in the normal text Vend.spy1 which is TEXT representing a link to a webpage.
    I'd like to change this to bring in the Vend.spy1 as a hyperlink
    I have followed my usual approach of peeking inside excel and creating a macro to see the VBA code which is shown below.

    Can anyone help with the correct code to achieve this I'm using PBWIN10 and #INCLUDE "Excel10.inc"
    I thought that there may have been a cell format option to set text to a hyperlink but this appears not to be the case.



    Code:
                          ' These two lines place normal text in the cell OK
                          ' however i'd like to change this text to a hyperlink
                     LET vX = 7  :  LET vY = 8 + CVMA&  : LET vText1 = TRIM$(Vend.spy1)
                     OBJECT LET oExcelWorkSheet.Cells.Item(vY, vX) = vText1
    
                             'Example from a macro inside MS Excel using VBasic
    
                     ' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                     '"C:\Users\Kevin\Documents\Book1.xlsx", TextToDisplay:= _
                     '"C:\Users\Kevin\Documents\Book1.xlsx"
    
                    'LET vX = 7  :  LET vY = 8 + CVMA&  : LET Address = TRIM$(Vend.spy1)
                    'OBJECT LET ???


    p.s. A big thank you to whoever put the new shine on this user forum.
    Last edited by Kevin Brown; 3 Apr 2016, 04:09 AM.
    “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

    Robert Burns (1759-96)

  • #2
    I persevered with this all day and eventually had a success.


    In the column G we enter the string Vend.spy1 in the format that the Excel formula bar will recognize e.g. "=HYPERLINK(""http://forum.powerbasic.com/"")"

    When we run OBJECT LET oExcelWorkSheet.Range(vRange).Cells.FormulaR1C1 = vText1
    the system recognizes this as a formula and handles the cell contents accordingly.

    The text in the cell G9 etc will be the full URL http://forum.powerbasic.com/ underlined and in blue.


    In column H we enter the string =HYPERLINK("http://www.bbc.co.uk","BBC") having two parts, the URL and the 'friendly' name.


    In this case text in the cell H9 etc will be the abbreviated friendly name BBC underlined and in blue, an abbreviated name for the full URL.


    I have tested this in a full program but will put this into a wee demo program later.



    Code:
    
     LET vRange = ("G"+ TRIM$(8 + CVMA&))
     LET vText1 = "=HYPERLINK("+ """"+ TRIM$(Vend.spy1)+""""+")"      
    
    ' Example   "=HYPERLINK(""http://forum.powerbasic.com/"")"
    
     OBJECT LET oExcelWorkSheet.Range(vRange).Cells.FormulaR1C1 = vText1
    
    
    
    
      ' This text is placed in a cell and identified as an MS Excel HYPERLINK
      ' Formula cell which can have two parts ,  the URL and a freindly name that
      ' the user sees in the excel cell.
      '         URL portion              Friendly name e.g BBC
      '  =HYPERLINK("http://www.bbc.co.uk","BBC")
    
     LET vRange = ("H"+ TRIM$(8 + CVMA&))
     LET vText1 = "=HYPERLINK("+ """"+ DRV$ +"peemail\Vendor\Catalogue\"+TRIM$(Vend.vdno) +"""" +","""+TRIM$(Vend.vdno)+"""" +")"
     OBJECT LET oExcelWorkSheet.Range(vRange).Cells.FormulaR1C1 = vText1
    Last edited by Kevin Brown; 4 Apr 2016, 01:36 AM.
    “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

    Robert Burns (1759-96)

    Comment


    • #3

      I have posted here a demo program which puts full and abbreviated hyperlinks into an excel document.


      Code:
      'Demonstration program by Kevin Brown for putting hyperlinks to excel from a listview file
      '05Mar2016
      
      #COMPILER PBWIN 10 ' EXE
      #DIM ALL
      
      #INCLUDE "Excel10.inc" 'Source of this document MCM 2Jun2011 From PB Forum then renamed
      
      %USEMACROS = 1
      #INCLUDE ONCE "WIN32API.INC"
      #INCLUDE ONCE "COMMCTRL.INC"
      
      
      GLOBAL S1DLG AS DWORD
      
      
      
      %IDC_BUTTON1 = 1000
      %IDC_LISTVIEW1 = 1001
      %IDC_BUTTON2 = 1002
      %IDC_BUTTON3 = 1003
      %IDC_LABEL1 = 1004
      %IDC_LABEL2 = 1005
      
      %XlBorderWeight_xlHairline = 1
      %XlBorderWeight_xlThin = 2
      %XlBorderWeight_xlMedium = -4138
      %XlBorderWeight_xlThick = 4
      %XlBordersIndex_xlEdgeLeft = 1
      %XlBordersIndex_xlEdgeTop = 2
      %XlBordersIndex_xlEdgeRight = 3
      %XlBordersIndex_xlEdgeBottom = 4
      %xlHAlignCenter = -4108
      %xlHAlignLeft = -4131
      %xlHAlignRight = -4152
      %xlVAlignCenter = -4108
      %xlLandscape = 2
      %xlPortrait = 1
      %xlPaperA4 = 9
      %xlPaperA3 = 8
      
      
      #PBFORMS DECLARATIONS
      
      DECLARE CALLBACK FUNCTION Dlg1DemoProc()
      DECLARE FUNCTION Dlg1Demo(BYVAL hDlg AS DWORD) AS LONG
      
      
      ' Compiler-independent helper Macro to display feedback and errors
      '
      MACRO m_DisplayResults(msg)
      #IF %DEF(%PB_CC32)
      STDOUT msg
      STDOUT "Press a key..."
      WAITKEY$
      LOCATE ,1
      #ELSE
      MSGBOX msg, &H00001000& ' %MB_SYSTEMMODAL
      #ENDIF
      END MACRO
      
      '------------------------------------------------------------------------------
      
      '------------------------------------------------------------------------------
      ' ** Main Application Entry Point **
      '------------------------------------------------------------------------------
      
      
      FUNCTION PBMAIN()
      
      Dlg1Demo %HWND_DESKTOP
      
      
      
      END FUNCTION
      
      
      
      FUNCTION Dlg1Demo(BYVAL hParent AS DWORD) AS LONG
      LOCAL lRslt AS LONG
      
      LOCAL hDlg AS DWORD
      
      DIALOG NEW PIXELS, hParent, "Demonstration Excel with hyperlink ( 1 ) ", 50, 50, 600, _
      200, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR _
      %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_VISIBLE OR %DS_SYSMODAL OR _
      %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
      
      CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "&Exit", 500, 150, 80, 20, _
      %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
      %BS_PUSHBUTTON OR %BS_CENTER OR %BS_TOP, %WS_EX_LEFT OR %WS_EX_LTRREADING
      
      CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "&Create Excel", 400, 150, 80, 20, _
      %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
      %BS_PUSHBUTTON OR %BS_CENTER OR %BS_TOP, %WS_EX_LEFT OR %WS_EX_LTRREADING
      
      CONTROL ADD BUTTON, hDlg, %IDC_BUTTON3, "&Load Data", 300, 150, 80, 20, _
      %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
      %BS_PUSHBUTTON OR %BS_CENTER OR %BS_TOP, %WS_EX_LEFT OR %WS_EX_LTRREADING
      
      CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Click Load Data and then Click Create Excel", 10, 140, 250, 20
      CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "This will save to C:\temp\Excel Demo.xls", 10, 160, 250, 20
      
      CONTROL ADD LISTVIEW, hDlg, %IDC_LISTVIEW1, "Listview1", 20, 20, 500, _
      100
      LISTVIEW SET STYLEXX hDlg, %IDC_LISTVIEW1, %LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT 'for LISTVIEW1
      '
      LISTVIEW INSERT COLUMN hDlg, %IDC_LISTVIEW1, 1, "Item 1", 80, 0
      LISTVIEW INSERT COLUMN hDlg, %IDC_LISTVIEW1, 2, "URL 2", 250, 0
      LISTVIEW INSERT COLUMN hDlg, %IDC_LISTVIEW1, 3, "'Friendly' Name 3", 100, 0
      
      DIALOG SHOW MODAL hDlg, CALL Dlg1DemoProc TO lRslt
      
      FUNCTION = lRslt
      END FUNCTION
      
      
      
      
      CALLBACK FUNCTION Dlg1DemoProc()
      S1DLG = CB.HNDL
      
      SELECT CASE AS LONG CB.MSG
      CASE %WM_INITDIALOG
      ' Initialization handler
      
      CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CB.WPARAM THEN
      ' Save control focus
      hWndSaveFocus = GetFocus()
      ELSEIF hWndSaveFocus THEN
      ' Restore control focus
      SetFocus(hWndSaveFocus)
      hWndSaveFocus = 0
      END IF
      
      CASE %WM_COMMAND
      ' Process control notifications
      SELECT CASE AS LONG CB.CTL
      
      
      CASE %IDC_BUTTON3 ' Load test data
      IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
      CALL Dlg1_LoadDataToListView
      END IF
      
      
      
      CASE %IDC_BUTTON2 ' Create Exel
      IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
      CALL Dlg1_MakeExcelFileFromListView
      END IF
      
      CASE %IDC_BUTTON1 ' Exit
      IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
      DIALOG END S1DLG
      END IF
      
      
      
      END SELECT
      
      
      CASE %WM_NOTIFY
      
      
      END SELECT
      END FUNCTION
      '------------------------------------------------------------------------------
      
      
      SUB Dlg1_LoadDataToListView
      
      DIM NR!
      
      DIM DataAry ( 1 TO 5, 1 TO 3) AS STRING * 50
      
      
      DataAry ( 1 ,1 ) ="1"
      DataAry ( 1 ,2 ) ="http://www.bbc.co.uk/news"
      DataAry ( 1 ,3 ) ="BBC"
      
      DataAry ( 2 ,1 ) ="2"
      DataAry ( 2 ,2 ) ="http://edition.cnn.com/"
      DataAry ( 2 ,3 ) ="CNN"
      
      DataAry ( 3 ,1 ) ="3"
      DataAry ( 3 ,2 ) ="https://www.rt.com/uk/"
      DataAry ( 3 ,3 ) ="RT"
      
      DataAry ( 4 ,1 ) ="4"
      DataAry ( 4 ,2 ) ="http://www.telemundo.com/noticias"
      DataAry ( 4 ,3 ) ="Telemundo"
      
      DataAry ( 5 ,1 ) ="5"
      DataAry ( 5 ,2 ) =" http://www.aljazeera.com/news/"
      DataAry ( 5 ,3 ) ="aljazeera"
      
      
      
      
      
      FOR NR! = 1 TO 5 STEP 1
      LISTVIEW INSERT ITEM S1DLG, %IDC_LISTVIEW1, 1, 0, TRIM$(DataAry (NR! ,1 )) _ 'Item
      : LISTVIEW SET TEXT S1DLG, %IDC_LISTVIEW1, 1, 2, TRIM$(DataAry (NR! ,2 )) _
      : LISTVIEW SET TEXT S1DLG, %IDC_LISTVIEW1, 1, 3, TRIM$(DataAry (NR! ,3 ))
      NEXT NR!
      
      LISTVIEW SORT S1DLG, %IDC_LISTVIEW1, 1 , NUMERIC , ASCEND ' Sort by item
      
      END SUB
      
      
      FUNCTION Dlg1_MakeExcelFileFromListView AS LONG
      
      
      
      DIM oExcelApp AS Excel_Application
      DIM oExcelWorkbook AS Excel_Workbook
      DIM oExcelWorkSheet AS Excel_WorkSheet
      
      
      DIM sProgID_Excel AS STRING
      
      DIM vBool AS VARIANT
      DIM vFile AS VARIANT
      DIM oVnt AS VARIANT
      DIM PrtVnt AS VARIANT
      DIM OrtVnt AS VARIANT
      DIM PgWVnt AS VARIANT
      DIM PgTVnt AS VARIANT '1 A3 page Tall
      DIM ZomVnt AS VARIANT 'Zoom %
      DIM OrdVnt AS VARIANT
      DIM WWVnt AS VARIANT 'Word Wrap
      DIM nVnt AS VARIANT
      DIM vVnt AS VARIANT
      DIM vVnt1 AS VARIANT
      DIM vVnt2 AS VARIANT
      DIM vVnt3 AS VARIANT
      DIM vVnt4 AS VARIANT
      DIM vVnt5 AS VARIANT
      DIM vVnt6 AS VARIANT
      DIM vVnt7 AS VARIANT
      DIM vText1 AS VARIANT
      DIM vRange AS VARIANT
      DIM vX AS VARIANT
      DIM vY AS VARIANT
      DIM vLink AS VARIANT
      DIM vSave AS VARIANT
      DIM vLeft AS VARIANT
      DIM vTop AS VARIANT
      DIM vWidth AS VARIANT
      DIM vHeight AS VARIANT
      DIM vValue AS VARIANT
      
      DIM vCellFmt AS VARIANT
      DIM vItem AS VARIANT
      
      DIM xlSolid AS VARIANT
      DIM vColour AS VARIANT
      
      
      
      DIM NR!
      DIM URL$
      DIM FNM$
      DIM TMP$
      DIM LV1C&
      
      '''''''''
      ' Open an instance of EXCEL
      oExcelApp = ANYCOM $PROGID_Excel_Application
      
      ' Could EXCEL be opened? If not, terminate this app
      IF ISFALSE ISOBJECT(oExcelApp) OR ERR THEN
      MSGBOX "Excel could not be opened. Please check that Excel and VBA are installed."
      EXIT FUNCTION
      END IF
      
      ' Make MSEXCEL visible
      LET vBool = 1
      OBJECT LET oExcelApp.Visible = vBool
      
      ' Create a new workbook in EXCEL
      OBJECT CALL oExcelApp.WorkBooks.Add TO oExcelWorkBook
      IF ISFALSE ISOBJECT(oExcelWorkbook) OR ERR THEN
      MSGBOX "Excel could not open a new workbook. Please check that VBA is installed."
      GOTO Terminate
      END IF
      
      ' Create a new worksheet in the workbook and use this
      ' worksheet reference to pump data into EXCEL
      OBJECT CALL oExcelWorkBook.WorkSheets.Add TO oExcelWorkSheet
      IF ISFALSE ISOBJECT(oExcelWorkSheet) OR ERR THEN
      MSGBOX "Excel could not open a new worksheet. Please check that VBA is installed."
      GOTO Terminate
      END IF
      
      
      
      
      LISTVIEW GET COUNT S1DLG, %IDC_LISTVIEW1 TO LV1C& 'Items ListView1
      
      ' Headers
      vText1 = "Item "
      LET vY = 1
      LET vx = 1
      LET vRange = ("A1:A6")
      LET vVnt1 = 20
      LET vVnt2 = 20 'Row height
      LET vVnt3 = %xlHAlignCenter 'Horz Align
      LET vVnt4 = %xlVAlignCenter 'Vert Align
      OBJECT LET oExcelWorkSheet.Range(vRange).ColumnWidth = vVnt1
      OBJECT LET oExcelWorkSheet.Range(vRange).RowHeight = vVnt2
      OBJECT LET oExcelWorkSheet.Range(vRange).HorizontalAlignment = vVnt3
      OBJECT LET oExcelWorkSheet.Range(vRange).VerticalAlignment = vVnt4
      OBJECT LET oExcelWorkSheet.Cells.Item(vY, vX) = vText1
      
      vText1 = "Full URL"
      LET vY = 1
      LET vx = 2
      LET vRange = ("B1:B6")
      LET vVnt1 = 60
      LET vVnt2 = 20 'Row height
      LET vVnt3 = %xlHAlignCenter 'Horz Align
      LET vVnt4 = %xlVAlignCenter 'Vert Align
      OBJECT LET oExcelWorkSheet.Range(vRange).ColumnWidth = vVnt1
      OBJECT LET oExcelWorkSheet.Range(vRange).RowHeight = vVnt2
      OBJECT LET oExcelWorkSheet.Range(vRange).HorizontalAlignment = vVnt3
      OBJECT LET oExcelWorkSheet.Range(vRange).VerticalAlignment = vVnt4
      OBJECT LET oExcelWorkSheet.Cells.Item(vY, vX) = vText1
      
      
      vText1 = "''Friendly' name URL "
      LET vY = 1
      LET vx = 3
      LET vRange = ("C1:C6")
      LET vVnt1 = 30
      LET vVnt2 = 20 'Row height
      LET vVnt3 = %xlHAlignCenter 'Horz Align
      LET vVnt4 = %xlVAlignCenter 'Vert Align
      OBJECT LET oExcelWorkSheet.Range(vRange).ColumnWidth = vVnt1
      OBJECT LET oExcelWorkSheet.Range(vRange).RowHeight = vVnt2
      OBJECT LET oExcelWorkSheet.Range(vRange).HorizontalAlignment = vVnt3
      OBJECT LET oExcelWorkSheet.Range(vRange).VerticalAlignment = vVnt4
      OBJECT LET oExcelWorkSheet.Cells.Item(vY, vX) = vText1
      
      
      
      'Cell Borders
      LET vRange = ("A2:C6")
      LET vVnt1 = %XlBorderWeight_xlThin 'Thin line
      OBJECT LET oExcelWorkSheet.Range(vRange).Borders.Weight = vVnt1
      
      LET vRange = ("A1:C1")
      LET vVnt1 = %XlBorderWeight_xlThick 'Thin line
      OBJECT LET oExcelWorkSheet.Range(vRange).Borders.Weight = vVnt1
      
      
      
      FOR NR! = 1 TO LV1C& STEP 1
      
      LISTVIEW GET TEXT S1DLG, %IDC_LISTVIEW1, NR!, 1 TO TMP$
      LET vX = 1: LET vY = NR+1 : LET vText1 = TMP$
      OBJECT LET oExcelWorkSheet.Cells.Item(vY, vX) = vText1
      
      
      LISTVIEW GET TEXT S1DLG, %IDC_LISTVIEW1, NR!, 2 TO URL$
      LET vRange = ("B"+ TRIM$(NR!+1))
      LET vText1 = "=HYPERLINK("+ """"+ URL$ +"""" +")"
      OBJECT LET oExcelWorkSheet.Range(vRange).Cells.FormulaR1C1 = vText1
      
      LISTVIEW GET TEXT S1DLG, %IDC_LISTVIEW1, NR!, 2 TO URL$
      LISTVIEW GET TEXT S1DLG, %IDC_LISTVIEW1, NR!, 3 TO FNM$
      LET vRange = ("C"+ TRIM$(NR!+1))
      LET vText1 = "=HYPERLINK("+ """"+ URL$ +"""" +","""+TRIM$(FNM$)+"""" +")"
      OBJECT LET oExcelWorkSheet.Range(vRange).Cells.FormulaR1C1 = vText1
      
      
      
      NEXT NR!
      
      LET vFile = "C:\temp\Excel Demo.xls"
      OBJECT CALL oExcelWorkSheet.SaveAs(vFile)
      ' MSGBOX VARIANT$( vFile) ,%MB_SYSTEMMODAL OR %MB_OK
      
      Terminate:
      ' Close the current document and then close EXCEL completely
      
      ' OBJECT CALL oExcelApp.ActiveWindow.CLOSE
      ' OBJECT CALL oExcelApp.Quit
      
      ' Release the interfaces. We could omit this since the
      ' app is about to close, but "best practice" states we
      ' should clean our house before moving out.
      ' oExcelApp = NOTHING
      ' oExcelWorkbook = NOTHING
      ' oExcelWorkSheet = NOTHING
      
      END FUNCTION
      “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

      Robert Burns (1759-96)

      Comment


      • #4
        You might find your code a little easier to maintain if you replace this line..
        Code:
         LET vText1 = "=HYPERLINK("+ """"+ DRV$ +"peemail\Vendor\Catalogue\"+TRIM$(Vend.vdno) +"""" """+TRIM$(Vend.vdno)+"""" +")"
        .. with a string expression using the $DQ equate. Best try doing it online..

        Code:
        Let vText1 = "=HYPERLINK(" & $DQ & DRV$ +"peemail\Vendor\Catalogue\"+TRIM$(Vend.vdno)  & $DQ, $DQ & TRIM$(Vend.vdno) & $DQ & ")"
        That is, for every double quote which is a legimate part of the string you are constructing, use $DQ and save the inline double-quote " to delimit literals in your string expression.

        MCM
        Michael Mattias
        Tal Systems Inc.
        Racine WI USA
        mmattias@talsystems.com
        http://www.talsystems.com

        Comment


        • #5
          Thank you Michael

          You are indeed correct it is easier to follow and maintain you must have heard my frustration when typing code again and again to get it correct. I will remember this tip $DQ, as payback $ Double Quick.
          “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

          Robert Burns (1759-96)

          Comment

          Working...
          X