- ベストアンサー
VBAでハイパーリンクのアドレスとテキストを一覧表示する方法について
- Excel VBAを使用して、シート内のすべてのハイパーリンクのアドレスとテキストを新しいシートに一覧表示するマクロを作成しています。
- しかし、h.TextToDisplayが空白またはエラーの場合に、実行時エラーが発生してしまいます。
- このエラーを回避する方法を教えてください。
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- Excel VBAで確認なしで上書き保存
起動中のBookでファイル名が Data.xlsのものを閉じたいと思いますが、 上書き確認メッセージを出さないように oExcel.DisplayAlerts = False を設定すると エラーになります。 CreateObject で作成した場合は、DisplayAlerts が使えるようですが、 すでに起動済みのBookを確認なしで上書き保存するにはどうしたらいい のでしょうか？ Sub UnloadFile() Dim myBook2 As Workbook Dim myBook1 As Workbook For Each myBook2 In Workbooks If myBook2.Name = "Data.xls" Then Set myBook1 = myBook2 myBook1.SaveAs myBook1.FullName myBook1.Close End If Next myBook2 Set myBook1 = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- VBAであるBOOKの「sample」というシートを別BOOKに
VBAであるBOOKの「sample」というシートを別BOOKに 別Bookにコピーしたいのですが、 ネットを参考にして下記のようにするとエラーになります。 実行時エラー'9' 「インデックスが有効範囲にありません」 と表示されます。 どこが間違っているでしょうか？ どなたか教えてください。 ---------------------------------------- Dim NewBook As Workbook Dim fName As String Set NewBook = Workbooks.Add fName = ThisWorkbook.Path & "cp.xls" NewBook.SaveAs Filename:=fName Workbooks("moto.xls").Sheets("ピッキング").Cells.Copy Workbooks(fName).Sheets("Sheet1").Paste Destination:=Cells(1, 1) '<---ここでエラー Workbooks(fName).Save ----------------------------------------
- ベストアンサー
- Visual Basic
- VBAの構文
Access2002を使用しています。 VBAにて、クエリの結果をメール本文に書き出したいのですが 宜しくお願いします。 【使用するクエリ】 クエリ名：果物クエリ（選択クエリ） フィールド項目：日付、注文者、発送先、電話番号、品名、数量 【現在の内容】 Private Sub コマンド1_Click() On Error GoTo Err_コマンド1_Click Dim stDocName As String Dim strsubject As String Dim strmailto As String Dim strmailto2 As String Dim strtext0 As String Dim strText1 As String Dim strText2 As String Dim strText3 As String Dim strText4 As String Dim strText5 As String Dim strtext6 As String Dim strtext7 As String Dim strtext8 As String Dim strtext9 As String strmailto = Me.電子メール_アドレス strsubject = "商品発送のお知らせ" strText1 = Me.氏名 & " 様" strText2 = "いつもお世話になります、第一青果です。" strText3 = "以下の商品を発送致しましたのでご確認下さいませ。 " strtext0 = "---------------------------------" strText4 = "何でも新鮮！" strText5 = "第一青果" strtext6 = "担当：山田 太郎" strtext7 = "mailto:info@808yaoya.net" strtext8 = "http://808yaoya.net" strtext9 = ★ここからクエリ内の「品名」と「数量」を書き出したい！★ ★以下、現在はレポートをエクセルファイルにして添付するようにしている★ stDocName = ChrW(32013) & ChrW(21697) & ChrW(12524) & ChrW(12509) & ChrW(12540) & ChrW(12488) DoCmd.SendObject acReport, stDocName, , strmailto, , , strsubject, strText1 & vbCrLf & vbCrLf & strText2 & _ vbCrLf & strText3 & vbCrLf & vbCrLf & strtext0 & vbCrLf & strText4 & vbCrLf & strText5 & vbCrLf & strtext6 & vbCrLf & _ strtext7 & vbCrLf & strtext8 & vbCrLf & strtext0 & vbCrLf & strtext9, True Exit_コマンド1_Click: Exit Sub Err_コマンド1_Click: MsgBox Err.Description Resume Exit_コマンド1_Click End Sub
- ベストアンサー
- その他(データベース)
- ハイパーリンクの表示で質問の続きです。
これで大丈夫かな？ Sub test() Dim i As Long For i = 1 To Range("A65536").End(xlUp).Row Cells(i, 1).Hyperlinks(1).TextToDisplay = Cells(i, 1).Hyperlinks(1).Address Cells(i, 2).Value = Cells(i, 1).Hyperlinks(1).Address Next i End Sub ------------------- 有難うございました。完璧ですが、 ハイパーリンクのないセルのところでエラーになります。 ハイパーリンクのないセルは無視（エラーを無視）して次のセルの作業を指示したいのですが、・・・お願いします。 しばらくVBAを離れていまして思い出せません。すみません。
- ベストアンサー
- Visual Basic
- EXCEL2007ではOKですが2003だとエラーになる
よろしくお願いします。 下記のコード（抜粋）がエクセル2007では全く問題なく動くのに、2003だとエラーになってしまうというもので困ってしまいました。 下記は二つのファイルの構成を比較して（OLDBOOKのシートをNEWBOOKと同じ構成にする）追加、削除、並び替えを行うというものです。 残念ながら、当方2003を持ってないので確認が出来ません。（当然配布は互換形式） 各配布先で試してもらったところ、2007のところは問題なし。2003のところはすべてエラーとなり、エラー箇所は抜粋している範囲のさらに2つのファイルを比較し、必要に応じて追加、削除を行う部分です。 Set shDst = OLDBOOK.Sheets(shSrc.Name) と Set shSrc = NEWBOOK.Sheets(shDst.Name) の部分で「454のオブジェクトエラー」となるとのことでした。原因は、そこにあると思いましたが、2007では問題ないので、何が悪いのかさっぱりです。どなたか助けて下さい。 Dim FIRSTBOOK As Workbook Dim OLDBOOK As Workbook Dim shSrc As Object Dim shDst As Object ～省略 ～ '現在の再計算モードの取得 iOldCalculation = Application.Calculation '再計算モードを手動に設定 Application.Calculation = xlManual '*****ここから比較***** ' // まず NEWBOOK.xls にあって OLDBOOK.xls にないシートをOLDBOOK.xls に複写 For Each shSrc In NEWBOOK.Sheets On Error Resume Next Set shDst = OLDBOOK.Sheets(shSrc.Name) On Error GoTo 0 If shDst Is Nothing Then shSrc.Copy After:=OLDBOOK.Sheets(OLDBOOK.Sheets.Count) End If Set shDst = Nothing Next ' // 続いてNEWBOOK.xls になくてOLDBOOK.xls にあるシートをOLDBOOK.xls から削除 For Each shDst In OLDBOOK.Sheets On Error Resume Next Set shSrc = NEWBOOK.Sheets(shDst.Name) On Error GoTo 0 If shSrc Is Nothing Then shDst.Delete End If Set shSrc = Nothing Next ' // シート並べ替え For Each shDst In OLDBOOK.Sheets shDst.Move Before:=OLDBOOK.Sheets(NEWBOOK.Sheets(shDst.Name).Index) shDst.Protect DrawingObjects:=True, Contents:=True, UserInterfaceOnly:=True Next '再計算モードの復元 Application.Calculation = iOldCalculation NEWBOOK.Close (False) '有無を言わずに保存せず閉じる ～省略 ～
- ベストアンサー
- Visual Basic
- マクロでファイル名を指定して保存する際にエラー
「全データ」というシートをマクロでファイル名に「伝票+実行時の日付・時間]をいれてCSV形式で保存したいと思い、 一度マクロを登録してみたのですが、途中でエラーが発生しうまくいきません。 「"」や「&」の付け方に問題があるかと思い、いろいろなパターンで試しましたが同様です。 修正記述がお分かりの方がいらっしゃいましたら、お言葉をいただけると幸いです。 宜しくお願いいたします。 ------------------------------------------------------------------------------------- Sheets("全データ").Select Dim file As Variant Dim NewBook As Workbook Dim NowSheet As Worksheet Set NowSheet = ActiveSheet file = Application.GetSaveAsFilename("伝票" & Now, "yy-mm-dd-hh-mm" & ".csv", "CSVカンマ区切り形式 (*.csv), *.csv") If file = False Then Exit Sub ←ここでエラー2015が発生 Set NewBook = Workbooks.Add NowSheet.Copy before:=NewBook.Worksheets(1) On Error Resume Next NewBook.Worksheets(1).SaveAs Filename:=file, FileFormat:=xlCSV On Error GoTo 0 Application.DisplayAlerts = False NewBook.Close Application.DisplayAlerts = True NowSheet.Activate End Sub
- ベストアンサー
- その他MS Office製品
- ハイパーリンクをコピペしてください
マクロで選択した各列の5行目以降に単独または連続コピペしたハイパーリンク付き文字列を下記のマクロにて第二階層分を上から順番にそのおのおの同じ行の隣の列にテキストファイルにてコピペ(セル内32767文字制限以下）してから置き換えで「*）は、」と「。*」で文字列を省略してください。 Sub HyperlinkFollowTest() On Error Resume Next Dim h As Hyperlink Dim sht As Worksheet Set sht = ActiveSheet '// シートの全ハイパーリンクをループ For Each h In sht.Hyperlinks '// ハイパーリンクを実行 Call h.Follow Next End Sub
- ベストアンサー
- Excel（エクセル）
- マクロが上手く組めない
各シートの特定のセル(1,25)にINDEXシートのハイパーリンクを 設定したいのですが、「オブジェクトが存在しません」 とエラーが表示されてしまっており、どのように修正すればいいのか 分からず、困っております。何故エラーが出たのかについてご教授頂けると幸いです。 私の書いたソースコード ********************************** ********************************** Sub INDEXLINK() Dim w As Worksheet Set w = Sheets("INDEX") Dim i As Long For i = 1 To ActiveWorkbook.Worksheets.Count Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1,25), Address:="", SubAddress:=w & "!c1", TextToDisplay:=w.Name Next End Sub
- ベストアンサー
- Visual Basic
- 下記のマクロをもっと早くするには？
下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub
- 締切済み
- Visual Basic
- InternetExplorer.Applicat
Sub test1() Dim objIE As Object Dim i As Long Dim MyRow As Long Dim Str As String Dim tmp As Variant Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "http://oshiete.goo.ne.jp/" objIE.Visible = True Do While objIE.Busy = True DoEvents Loop Str = objIE.Document.Body.innerHTML 'ソースを抜き出す tmp = Split(Str, Chr(10)) '配列に格納する MyRow = 1 '初期値 For i = LBound(tmp) To UBound(tmp) Cells(MyRow, 1) = tmp(i) MyRow = MyRow + 1 Next i objIE.Quit Set objIE = Nothing End Sub ************************************************** Sub test2() Dim objIE As Object Dim Str As String Dim tmp As Variant Dim i As Long Dim MyRow As Long Set objIE = CreateObject("MSXML2.XMLHTTP") objIE.Open "GET", "http://oshiete.goo.ne.jp/", False objIE.Send Str = objIE.responseText 'ソースを抜き出す tmp = Split(Str, Chr(10)) '配列に格納する MyRow = 1 '初期値 For i = LBound(tmp) To UBound(tmp) Cells(MyRow, 1) = tmp(i) MyRow = MyRow + 1 Next i Set objIE = Nothing End Sub ************************************************** 上記の二つのコードは どちらもＶＢＡでHTMLソースをエクセルに書き出すコードなのですが 結果が違います。 なぜなのでしょうか？ 実際のソースを確認したら CreateObject("MSXML2.XMLHTTP") の方が正しかったです。 CreateObject("InternetExplorer.Application") は何が取得されてるのでしょうか？
- ベストアンサー
- Visual Basic
お礼
If h.Type = msoHyperlinkShape Then にしたらうまくできました。 とても十分なご説明です。ありがとうございました。