「dポイント」が最大20倍になるお得な情報

下記URLのサンプルファイルに含まれるVBAで作成されたユーザー定義関数について、
Excel2003(Windows7)の環境で利用することが出来ました。
http://www.relief.jp/itnote/archives/003799.php

しかしながら、Excel2010およびExcel2013(ともにWindows7)で開くと、結果が
#VALUE! と変わってしまい、正しく表示されませんでした。

VBAの参照設定でも同じものにチェックを入れている状態ですが、うまくいきません。
(ただし、Microsoft Excel XX.X Object LibraryやMicrosoft Office XX.X Object Library
などバージョンの差異はあり)

Excel2010またはExcel2013において、このユーザー定義関数を
正しく利用できる方法が分かりましたらご教示いただけますと助かります。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

64ビット版のWindowsをお使いの場合には、


MSScript.ocxが存在しないのでScriptControlも使えません。
ExcelではなくてWindowsが64ビットか32ビットか、の問題のようです。
#私は64ビットでインストール出来るものはすべて64ビットしか経験がないので、
#32ビットなら動くのかどうか、わかりませんが、、、。

『64ビット版OfficeでURLエンコード処理ができない?に対する返信1 』
http://dirtysexyquery.blogspot.jp/2011/10/64offi …
『64ビット環境でのScriptControlの代わり』
http://www.ka-net.org/office/of32.html
ダウンロード『•MSScript.ocxが存在しない64ビット版のWindowsでScriptControlを動作するようにします。』
http://www.eonet.ne.jp/~gakana/tablacus/scriptco …
以上、原因を知ることと、対策の可能性について、参考になると思います。

以下、元々64ビット環境用に書いていたものですが、
結果的に32ビットでもいけるので、汎用性を考えるとこんな感じになると思います。
関数名(2カ所)は、お好きなように。

' ' /// URL文字列(UTF-8)をデコードする(64bitOS対応)
Function DecodeUTF8(ByVal Source As String) As String
  Dim oHtmlFile As Object
  Dim oElement As Object

  Source = Replace(Source, "\", "\\")
  Source = Replace(Source, "'", "\'")

  Set oHtmlFile = CreateObject("htmlfile")
  Set oElement = oHtmlFile.createElement("span")
  oElement.setAttribute "id", "response"
  oHtmlFile.appendChild oElement
  oHtmlFile.parentWindow.execScript _
        "document.getElementById('response').innerText " _
        & "= decodeURIComponent('" & Source & "');", "JScript"
  DecodeUTF8 = oElement.innerText
End Function
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
てっきりExcelのバージョン違いが原因と思い込んでしまい、
OSの32bit/64bitの違いに考えが至りませんでした。

また、教えて頂いたリンク先等を見て原因は分かっても、
自分のスキルでは動作するコードを書くことは出来なかったため、
コードもご提示頂きまして大変感謝しております。

こちらのWindows7 64bit & Excel2013 64bit環境で
利用できますこと、確認いたしました。

本当にありがとうございました!

お礼日時:2014/09/02 22:43

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QVBAでShift-JISのURLエンコード

Excelにおいて、マクロを使ってShint-JIS形式のエンコードを行いたいのですが
その方法(ソース)がネット上で見つかりません。。どなたかご教授いただけないでしょか!

 ※VBA(マクロ)について、ぜんぜん詳しくありません。。

検索 ⇒ %8c%9f%8d%f5


UTF-8の場合ならば、シンプルなものが見つかりました。
-----------------------------------------------------
Public Function UrlEncode(ByVal sText As String) As String
If Len(sText) = 0 Then Exit Function

With CreateObject("ScriptControl")
.Language = "JScript"
UrlEncode = .CodeObject.encodeURIComponent(sText)
End With

End Function





また、デコードするものも見つかりました。
-----------------------------------------------------
Function URLDecodeSJIS(src)
src = UnEscape(src)
For i = 1 To Len(src)
srcCh1 = AscW(Mid(src, i, 1))
If (&H0 <= srcCh1 And srcCh1 <= &H80) Or (&HA0 <= srcCh1 And srcCh1 <= &HDF) Then
URLDecodeSJIS = URLDecodeSJIS & Chr(srcCh1)
ElseIf (&H81 <= srcCh1 And srcCh1 <= &H9F) Or (&HE0 <= srcCh1 And srcCh1 <= &HFF) Then
i = i + 1
srcCh2 = AscW(Mid(src, i, 1))
clcCh = srcCh1 * 256 + srcCh2
If (Asc(Chr(clcCh)) And &HFFFF&) = clcCh Then clcCh = Chr(clcCh)
URLDecodeSJIS = URLDecodeSJIS & clcCh
End If
Next
End Function

Function UnEscape(s)
With CreateObject("MSScriptControl.ScriptControl")
.Language = "VBScript"
.Reset
UnEscape = .Eval("unescape(""" & s & """)")
End With
End Function


よろしくお願い致します。

Excelにおいて、マクロを使ってShint-JIS形式のエンコードを行いたいのですが
その方法(ソース)がネット上で見つかりません。。どなたかご教授いただけないでしょか!

 ※VBA(マクロ)について、ぜんぜん詳しくありません。。

検索 ⇒ %8c%9f%8d%f5


UTF-8の場合ならば、シンプルなものが見つかりました。
-----------------------------------------------------
Public Function UrlEncode(ByVal sText As String) As String
If Len(sText) = 0 Then Exit Function

With CreateObject("ScriptCo...続きを読む

Aベストアンサー

なかなか回答がつかないようなので、自信はありませんが回答させていただきます。
(回答がつかないよりはいいと思いますので・・・)

文字をシフトJISの文字コードに直すには、単にAsc関数を使えばいいはずです。ただし、文字コードが&H8000 (32768) 以上のものは負になるので補正が必要です。

Function CharToSJISCode(Char As String) As Long
Dim c As Long
c = Asc(Char)
If c < 0 Then c = c + &H10000
CharToSJISCode = c
End Function

1バイト文字のエンコードですが、文字コードが&H7F (127) 以下のものですが、おそらくUTF-8と同じだと思いますので質問者様提示の関数 UrlEncode をそのまま使わせていただきます。
&H80から&HFF (128から255)はおそらくすべてエンコードすればいいと思います。エンコードの方法は文字コードの16進数2桁の左に%をつけます。
(1バイト文字については特に自信がありません)

Function EncodeSJIS1byte(code) As String
If code <= &H7F Then
EncodeSJIS1byte = UrlEncode(Chr(code))
Else
EncodeSJIS1byte = "%" & Hex(code)
End If
End Function

2バイト文字のエンコードですが、二つに分割して1バイトずつエンコードするのはよいとして、Wikipediaのパーセントエンコーディング(http://ja.wikipedia.org/wiki/%E3%83%91%E3%83%BC%E3%82%BB%E3%83%B3%E3%83%88%E3%82%A8%E3%83%B3%E3%82%B3%E3%83%BC%E3%83%87%E3%82%A3%E3%83%B3%E3%82%B0) のところを読むと、すべてエンコーディングしても、1バイト文字と見なして必要なものだけエンコーディングしてもいいようです。ここでは、後者の方法、具体的には今書いたばかりのEncodeSJIS1byteでエンコードするようにしてみます。

Function EncodeSJIS2byte(Code) As String
EncodeSJIS2byte = EncodeSJIS1byte(Code \ &H100) & EncodeSJIS1byte(Code Mod &H100)
End Function

これまで書いた関数を用いてシフトJISエンコードを書きます。

Function UrlEncodeSJIS(SStr As String) As String
Dim DStr As String
Dim i As Long, c As Long
For i = 1 To Len(SStr)
c = CharToSJISCode(Mid(SStr, i, 1))
If c < &H100 Then
DStr = DStr & EncodeSJIS1byte(c)
Else
DStr = DStr & EncodeSJIS2byte(c)
End If
Next
UrlEncodeSJIS = DStr
End Function

以上です。
最初に申し上げたとおり自信がありません。
そのため、ご使用になる際は十分にテストして不具合がないか確認していただきたくお願いします。

なかなか回答がつかないようなので、自信はありませんが回答させていただきます。
(回答がつかないよりはいいと思いますので・・・)

文字をシフトJISの文字コードに直すには、単にAsc関数を使えばいいはずです。ただし、文字コードが&H8000 (32768) 以上のものは負になるので補正が必要です。

Function CharToSJISCode(Char As String) As Long
Dim c As Long
c = Asc(Char)
If c < 0 Then c = c + &H10000
CharToSJISCode = c
End Function

1バイト文字のエンコードですが、文字コードが&H...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qエンコード・デコードの仕方

インターネットのアドレス欄に良く見る
%a4%db%a4%b2%a4%db%a4%b2+%a4%db%a4%cb%a4%e3%a4%e9%a4%e9%a1%c1
って感じのエンコード文字列ですが、
これはナニ形式と呼ぶのでしょうか?

また、この文字列をデコードするにはどうしたらよいのでしょう?

Excelマクロ(VBA)のなかでちょっと使ってみたいので、
どなたか、ご教示の程おねがいします。

Aベストアンサー

(゜▽゜*)♪ニパッ
個人的なロジック公開しちゃう
バグあるかも?

Sub Main()
  MsgBox convUrltoUni("%a4%db%a4%b2%a4%db%a4%b2+%a4%db%a4%cb%a4%e3%a4%e9%a4%e9%a1%c1")
End Sub

Public Function convUrltoUni(inVal As String)
  Dim lngLen   As Long   '文字長
  Dim lngFindPos As Long   '%文字を見つけた位置
  Dim lngStart  As Long   '検索開始位置
  Dim strWk    As String  '文字列連結用ワーク
  Dim blnHigh   As Boolean '文字列が全角か半角によって切り替わるフラグ
  Dim bytWk    As Byte   '「%**」の値
  
  Dim bytHigh   As Byte   '全角文字の時の上位バイト
  Dim bytLow   As Byte   '全角文字の時の下位バイト
  Dim bytChar1  As Byte   '変換ワーク上位
  Dim bytChar2  As Byte   '変換ワーク下位
  
  Dim eucCrLf   As Byte   'EUCの改行コード
  
  'EUC改行コードを取得
  eucCrLf = Asc(vbLf)
  
  '文字長を得る
  lngLen = Len(inVal)
  
  '検索開始位置デフォルト
  lngStart = 1
  
  '上位バイトの処理を行ったことを記すフラグをおろす
  blnHigh = False
  Do
    '%文字を見つける
    lngFindPos = InStr(lngStart, inVal, "%")
    '見つからなかったら、文字長+1をセット
    If lngFindPos = 0 Then
      lngFindPos = lngLen + 1
    End If
    
    '検索開始位置と「%」の発見位置が違うなら、半角文字が存在していることになる
    If lngFindPos <> lngStart Then
      '半角文字なので、そのままセット
      strWk = strWk & Mid(inVal, lngStart, lngFindPos - lngStart)
      blnHigh = False
    End If
    
    '「%」の発見位置が文字長を超えていたら抜ける
    If lngFindPos >= lngLen Then
      Exit Do
    End If
    
    'バイト値としてゲット
    bytWk = CByte("&H" & (Mid(inVal, lngFindPos + 1, 2)))
    
    '先に上位バイトの処理がなされていないなら
    If Not blnHigh Then
      '半角文字の時の処理
      If bytWk < &H80 Then
        '改行コードの処理
        If bytWk = eucCrLf Then
          strWk = strWk & vbCrLf
        '改行コード以外の処理
        Else
          strWk = strWk + Chr(bytWk)
        End If
        
      '半角文字でないときの処理
      Else
        '下位バイトが必要なので、上位バイトとして値を記憶
        bytHigh = bytWk - &H80
        '変換準備上位(ここはお決まり変換ロジック)
        If bytHigh < 95 Then
          bytChar1 = 112
        Else
          bytChar1 = 176
        End If
        
        '上位バイトの処理を行ったことを記すフラグを立てる
        blnHigh = True
      End If
    
    'すでに上位バイトの処理がされている時
    Else
      '上位バイトと組み合わせての変換処理(ここはお決まり変換ロジック)
      bytLow = bytWk - &H80
      If bytHigh Mod 2 = 1 Then
        If bytLow > 95 Then
          bytChar2 = 32
        Else
          bytChar2 = 31
        End If
      Else
        bytChar2 = 126
      End If
      bytHigh = ((bytHigh + 1) \ 2) + bytChar1
      bytLow = bytLow + bytChar2
      
      strWk = strWk & Chr(CInt("&H" & Hex(bytHigh) & Hex(bytLow)))
      
      '上位バイトの処理を行ったことを記すフラグをおろす
      blnHigh = False
    End If
    
    lngStart = lngFindPos + 3
  Loop
  
  convUrltoUni = strWk
End Function

(゜▽゜*)♪ニパッ
個人的なロジック公開しちゃう
バグあるかも?

Sub Main()
  MsgBox convUrltoUni("%a4%db%a4%b2%a4%db%a4%b2+%a4%db%a4%cb%a4%e3%a4%e9%a4%e9%a1%c1")
End Sub

Public Function convUrltoUni(inVal As String)
  Dim lngLen   As Long   '文字長
  Dim lngFindPos As Long   '%文字を見つけた位置
  Dim lngStart  As Long   '検索開始位置
  Dim strWk    As String  '文字列連結用ワーク
  Dim blnHigh   As Boolean '文字列が全角か半角によ...続きを読む

QWebページ中の javascript をVBAから実行するには

VBAで objIE を使用して Webページ中の javascript を実行したいのですが、
onclick="~~" の記述がないケースがあり困っております。
例えば以下のような記述です。

<a href="javascript:;" pnb="~~" scdaction="~~" bulkaction="~~" id="~~">~~</a>

onclick の記述がない上記のようなケースでは、javascript の呼び出しはどのようにすればよいのでしょうか?
不可能でしょうか?

Aベストアンサー

ここを読んでみればよいのですが、だらだらと文章が長いですね。^^;
http://www.ken3.org/vba/backno/vba170.html
この内容のまとめは、この後でします。もし、ダメだったら、こちらも読んでください。

>onclick="~~" の記述がないケースがあり困っております。

最初に、ストレートな回答ではありませんが、私の場合、いくつかの方法を試しています。

>a href="javascript:;" pnb="~~" scdaction="~~" bulkaction="~~" id="~~">~~</a>
この場合は、id がありますから、確実のオブジェクトとして取得できますから、まず最初に、ダメ元で、
id名.Click を一度試してみます。もしくは、この行の上部のコードのオブジェクトのClass名のオブジェクトのひとつから、ヒットさせようとします。

そこでダメなら、ということで、ken3の内容に入るのですが、この著者の結論(正解)は、

ご質問に沿って書くと
For i =0 To objIE.Document.links.Length -1
If objIE.Document.links(i).href ="javascript:;" Then '文字の比較は、大文字・小文字がある
   objIE.Document.Links(i).Click
End if
Next i

ということになっています。私は、このコードは少し古臭く感じます。

ここで、ken3 の所では、Testサイトを用意してくれているので、試してみましたが、ダイレクトでサイトがとれている限りは、やはり、

Testサイト:http://www.ken3.org/vba/test170f.html

 objIE.Navigate "javascript:xxxxx;"

が利くことが分かりました。ただし、実際は、ここで時間待ちをしなくてはならないでしょう。
解説は、フレームからですので、うまく行かなかったようです。

ここを読んでみればよいのですが、だらだらと文章が長いですね。^^;
http://www.ken3.org/vba/backno/vba170.html
この内容のまとめは、この後でします。もし、ダメだったら、こちらも読んでください。

>onclick="~~" の記述がないケースがあり困っております。

最初に、ストレートな回答ではありませんが、私の場合、いくつかの方法を試しています。

>a href="javascript:;" pnb="~~" scdaction="~~" bulkaction="~~" id="~~">~~</a>
この場合は、id がありますから、確実のオブジェクトとして取得できますか...続きを読む

Qセルに入力されている文字列をUTF-8形式にURLエンコードする方法

Excelでセルに入力されている文字列をUTF-8形式にURLエンコードする方法を探しています。

下記のURLでShift-JISにURLエンコードできるものは提供されているのですが、
UTF-8に変換できるものは見つかりませんでした。

http://www.vector.co.jp/soft/winnt/net/se369699.html

どうぞよろしくお願いいたします。

Aベストアンサー

> このソースはVBAを立ち上げてコピペかなにかで使用するのでしょうか、
> それともJScript用にエディタか何かで記述するのでしょうか…

■ マクロ(VBA)で使う場合の手順

1. Excel起動
2. [Alt]+[F11] キーを押して Visual Basic Editor(以下 VBE)起動
3. VBE メニューで [挿入]-[標準モジュール] をクリック
4. 3. で開いたスペースに #4 の以下のコードをコピー&ペースト
  ただし、このサイトは URL を投稿すると前後に?記号がくっつく
  ので、除去して下さい
5. VBE を閉じる
6. A1 セルに適当な文字を入れ、[Alt]+[F8] を押してマクロ実行

■ワークシートで使う場合の手順

1. 1.~5.まではマクロで使う場合と同じ
2. ワークシートに戻る
3. A1 セルに適当な文字を入力
4. B1 セルに次の数式を入力
  =UrlEncode(A1)

QエクセルでハイパーリンクのURLだけを文字抽出したい

ホームページからコピーし、エクセルにリンク文字をペーストすると、青文字(文字にハイパーリンクがかかった状態)が貼りつきます。その張り付いた文字の、リンク先URLを文字としてほしい(http○○・・)のですが、できますか?
青文字を右クリックしてハイパーリンクの編集からURLは見られるのですが、たくさんのリンクリストからURLだけを抽出するのが大変なので、よい方法がありましたらお願いします。

Aベストアンサー

No3 です。
サブアドレスの存在を忘れていました。
訂正です。

Public Sub GetURL()
  Dim h As Hyperlink
  Dim a As String
  Dim s As String
  For Each h In ActiveSheet.Hyperlinks
    a = h.Address
    s = h.SubAddress
    If s <> "" Then
      a = a & "#" & s
    End If
    h.Range.Offset(0, 1) = a
  Next
End Sub

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QFunctionの戻り値を配列にしたいのですが

vbを始めたばかりですがよろしくお願いします。

Functionの戻り値を配列にしたいのですが

Function fnc(ByVal a As Byte, ByVal b As Byte) As Integer()
fnc(0) = a + b
fnc(1) = a - b
End Function
というような使い方はできないのでしょうか?
一つのFunctionで二つの計算結果をかえすには
どうしたらよいのでしょうか?
お願いします。

Aベストアンサー

ローカル変数を使えば可能だと思いますよ

VB6.0の場合
Function fnc( byVal a as Byte, Byval b as Byte) as Integer
  dim ar(1) as Integer
  ar(0) = a + b
  ar(1) = a - b
  fnc = ar
End Function

VB.NETなら
Function fnc( byVal a as Byte, Byval b as Byte) as Integer
  dim ar(1) as Integer
  ar(0) = a + b
  ar(1) = a - b
  return ar
End Function

VB.NETでも fnc = ar と言った記述も出来ます

呼び出し側では 動的配列として返り値を受けます
dim results() as Integer
results = fnc( 5, 3 )
と言った具合です

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QエクセルVBA 「On Error GoTo 0」について

「On Error GoTo 」ステートメントの意味は、だいたい理解しています。
「On Error GoTo 0」 ステートメントについて、ご教授お願いします。
参考書には「エラーのトラップ処理を無効にする」と載っていましたが、よくわかりません。
具体的にどのような使い方をするのか、簡単なコードで説明していただければ幸いです。
よろしくお願いします。

Aベストアンサー

#3の回答者ですが、コードのどこが原因か特定し、実行時エラーとして、そのエラーが不可避な場合において、On Error Resume Next を付けますから、On Error Goto ErrHandler よりも、扱い方が難しいです。当然、その部分だけの範囲を囲うので、On Error Goto 0 を入れると思いますし、今では、使う場面が限定されているはずです。

後はテキストを参考にしてください。当面、このようなコードが必要になることはないと思いますが。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング