• 締切済み

「ByRef引数の型が一致しません」助けてください。

お世話になります。 現在VBAでHTMLの書き出し用プログラムを書いています。 書き出したHTMLをUTF-8に変換するため、 ■UTF-8ファイル作成 for VBA http://www.vector.co.jp/soft/dl/winnt/prog/se320375.html のクラスモジュールを利用させていただいております。 Sub testAで定義した内容を書き出すために、 Sub createTestでtestA fNum(i)とした場合、 「ByRef引数の型が一致しません」と怒られてしまいます…。 単数の生成であれば、testA f1で生成可能なのですが、 生成ファイルが複数あり、配列に格納して処理したいのです。 どなたかお力をお貸しください。 プログラムの知識はほぼ素人レベルですorz 宜しくお願いします。 ▼コード Option Explicit Public Sub createTest() Dim fNum As Variant Dim f1 As New TextFile, f2 As New TextFile, f3 As New TextFile, f4 As New TextFile, f5 As New TextFile, f6 As New TextFile Dim f7 As New TextFile, f8 As New TextFile, f9 As New TextFile, f10 As New TextFile, f11 As New TextFile, f12 As New TextFile Dim f13 As New TextFile, f14 As New TextFile, f15 As New TextFile, f16 As New TextFile, f17 As New TextFile Dim Header As String, BodyS_T As String, BodyS_L As String, GlNavi As String, Promo As String, Contents As String, PrNavi As String, SeNavi As String, Footer As String, BodyE As String Dim ContentsM As String, ContentsS As String Dim WBK As Workbook Dim SH2 As Worksheet Dim TplBox As Variant Dim createCurPath As String Dim i As Integer Set WBK = ThisWorkbook Set SH2 = WBK.Sheets(2) createCurPath = ThisWorkbook.path & "\" & UserForm1.TextBox1.Value fNum = Array(f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17) '<HEADER> Header = "Header" '<BODY-START> BodyS_T = "BodyS_T>" BodyS_L = "BodyS_L" '<GLOBAL NAVI> GlNavi = "GlNavi" '<PROMO> Promo = "Promo" '<CONTENTS> Contents = "Contents" ContentsM = "ContentsM" ContentsS = "ContentsS" '<PRIMRY NAVi> PrNavi = "PrNavi" '<SECONDARY NAVI> SeNavi = "SeNavi" '<FOOTER> Footer = "Footer" '<BODY-END> BodyE = "BodyE" For i = 0 To 16 If i = 0 Then fNum(i).FileCreate createCurPath & "\index.html", "UTF-8" ElseIf UserForm1("TextBox" & i + 1).Value <> "" Then fNum(i).FileCreate createCurPath & "\" & UserForm1("TextBox" & i + 1).Value & "\index.html", "UTF-8" End If fNum(i).TextWriteLine Header If i = 0 Then fNum(i).TextWriteLine BodyS_T ElseIf UserForm1("TextBox" & i + 1).Value <> "" Then fNum(i).TextWriteLine BodyS_L End If TplBox = SH2.Range("C" & i + 3).Value If TplBox <> "" Or TplBox <> "選択" Then If InStr(TplBox, "-TA-") > 0 Then testA fNum(i) fNum(i).TextWriteLine Promo fNum(i).TextWriteLine PrNavi ElseIf InStr(TplBox, "-TB-") > 0 Then testA fNum(i) fNum(i).TextWriteLine "<hr />" ElseIf InStr(TplBox, "-TC-") > 0 Then fNum(i).TextWriteLine ContentsS End If End If fNum(i).FileClose Next i End Sub Public Sub testA(f As TextFile) f.TextWriteLine "テスト1" End Sub

みんなの回答

  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.2

> ByRef(参照渡し)からByVal(値渡し)に変更した際に > 出てくる問題点等ありますでしょうか。 たぶん大丈夫だと思います ・・・ ByValにした場合メモリー上で引数がコピーされてこれが渡されることのなります このコピーは必要が無くなればVBが後片付けをしますが 後片付けがいつ行われるかは プログラム上で制御するのが不能です これが原因でメモリーを圧迫してOutOfMemoryなどのエラーが発生する可能性はありますが 今回ぐらいの規模なら大丈夫でしょう

miyumi20
質問者

お礼

大変参考になりました。 本当にありがとうございました!!

全文を見る
すると、全ての回答が全文表示されます。
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

VBAではユーザーが型定義したオブジェクトを引数に持つプロシージャは暗黙的に ByRef(参照渡し)で行われます Public Sub TestA( f as TextFile) と記述した場合 Public Sub TestA(ByRef f as TextFile) と記述したのと同じになります このByRefでは呼び出し元と呼び出し先で型が一致している必要があります しかしお示しのコードでは fNumはVariant型なのに対し TestAの引数はTextFile型になっているので一致していない といっているのでしょう TestA側を Public Sub TestA( ByVal f as TextFile) といった具合に ByVal(値渡し)で上手くいかないでしょうか

miyumi20
質問者

お礼

redfox63様 ご回答ありがとうございます。 >TestA側を >Public Sub TestA( ByVal f as TextFile) 上記で試したところ無事解決できました!! 本当にありがとうございました! あと一点ご質問なのですが、 ByRef(参照渡し)からByVal(値渡し)に変更した際に 出てくる問題点等ありますでしょうか。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • 「ByRef引数の型が一致しません」・・・orz

    お世話になります。 一昨日からエクセルのVBAをやりはじめたのですが、 表題のエラーが回避できなくて困っております。 下記のコードの Sub 繰越判定(cellno1 As Long, cellno2 As Long, cellno3 As Long, kamoku As String, bunrui As String, karikatakamoku As String, kasikatakamoku As String, tekiyou As String, kurikosi As Long) の行が黄色になり、そこから17行下の Call 当期(cellno1, cellno2, cellno3, kamoku, bunrui, karikatakamoku, kasikatakamoku, tekiyou, kurikosi) のtekiyouの部分が青く変わります。 お分かりになる方がいらっしゃいましたら お助けください。 以下コードです。 Sub 総勘定元帳() '開始行の設定 Dim cellno1 As Long '総勘定元帳の開始行 Dim cellno2 As Long 'マスタの検索行 Dim cellno3 As Long 'データの検索開始行 Dim kamoku As String 'マスタの科目 Dim bunrui As String 'マスタの(科目の)分類 Dim karikatakamoku As String Dim kasikatakamoku As String Dim tekiyou As String Dim kurikosi As Long cellno1 = 5 kurikosi = 0 kamoku = Sheets("マスタ").Range("B3") bunrui = Sheets("マスタ").Range("C3") Call 繰越判定(cellno1, cellno2, cellno3, kamoku, bunrui, karikatakamoku, kasikatakamoku, tekiyou, kurikosi) End Sub Sub 繰越判定(cellno1 As Long, cellno2 As Long, cellno3 As Long, kamoku As String, bunrui As String, karikatakamoku As String, kasikatakamoku As String, tekiyou As String, kurikosi As Long) cellno2 = 3 'マスタの開始行数セット cellno3 = 5 'データの開始行数セット kamoku = Sheets("マスタ").Range("B" & cellno2) karikatakamoku = Sheets("データ").Range("F" & cellno3) tekiyou = Sheets("データ").Range("G" & cellno3) kasikatakamoku = Sheets("データ").Range("H" & cellno3) 'MsgBox kamoku 'MsgBox karikatakamoku 'MsgBox tekiyou 'MsgBox kasikatakamoku If kurikosi = 0 Then '前期繰越か当期かの判定 Call 繰越(cellno1, cellno2, cellno3, kamoku, bunrui, karikatakamoku, kasikatakamoku, tekiyou, kurikosi) Else Call 当期(cellno1, cellno2, cellno3, kamoku, bunrui, karikatakamoku, kasikatakamoku, tekiyou, kurikosi) End If End Sub Sub 繰越(cellno1 As Long, cellno2 As Long, cellno3 As Long, kamoku As String, bunrui As String, karikatakamoku As String, kasikatakamoku As String, tekiyou As String, kurikosi As Long) Range("a1") = kamoku '科目タイトル出力 Range("C" & cellno1) = "前期繰越" If bunrui = "資産" Or bunrui = "資産2" Or bunrui = "収益" Then '科目分類の判定 Set マスタ = Sheets("決算") Set 範囲 = マスタ.Range("A68:B90") Range("D" & cellno1) = Application.WorksheetFunction.VLookup(bunrui, 範囲, 2) End If Call 当期(cellno1, cellno2, cellno3, kamoku, bunrui, karikatakamoku, kasikatakamoku, tekiyou, kurikosi) End Sub Sub 当期(cellno1 As Long, cellno2 As Long, cellno3 As Long, kamoku As String, karikatakamoku As String, kasikatakamoku As String, tekiyou As String, kurikosi As Long) Do Until cellno3 = 30 If kurikosi = 0 Then Select Case kamoku Case karikatakamoku MsgBox karikatakamoku cellno3 = cellno3 + 1 karikatakamoku = Sheets("データ").Range("F" & cellno3) karikatakamoku = Sheets("データ").Range("F" & cellno3) Case kasikatakamoku MsgBox kasikatakamoku cellno3 = cellno3 + 1 kasikatakamoku = Sheets("データ").Range("H" & cellno3) karikatakamoku = Sheets("データ").Range("F" & cellno3) Case Else cellno3 = cellno3 + 1 karikatakamoku = Sheets("データ").Range("F" & cellno3) kasikatakamoku = Sheets("データ").Range("H" & cellno3) MsgBox cellno3 End Select Loop End Sub

  • Excel VBA ByRef引数の型?

    Excel2010でセルに関数式を埋め込むマクロを書いています。 そこで、「ByRef引数の型が一致しません」というエラーが出て困っています。 プログラムの中からエラーの出る所だけを取り出してtest1,test2として試したところ、 test1はエラーが出て、test2はプログラムが動いて目的とするセルに関数式が挿入されました。 Sub test1() dim i, myR as integer myR = 30 For i = 7 To 31 Cells(4, i) = "=IF(" & ConvertToLetter(i) & i - 4 & "="""","""",SUM(" & ConvertToLetter(i) & "5:" & ConvertToLetter(i) & myR & ")/(" & myR & "-COUNTIF(" & ConvertToLetter(i) & "5:" & ConvertToLetter(i) & myR & ","""")))" next i End Sub test1でConvertToLetter(i)のiが青色で選択され「ByRef引数の型不一致」エラーとなってしまいます。 そこで、試しに一度変数iの値をkに渡して同じプログラムをtest2として実行してみました。 Sub test2() dim i, k, myR as integer myR = 30 For i = 7 To 31 k=i Cells(4, i) = "=IF(" & ConvertToLetter(k) & i - 4 & "="""","""",SUM(" & ConvertToLetter(k) & "5:" & ConvertToLetter(k) & myR & ")/(" & myR & "-COUNTIF(" & ConvertToLetter(k) & "5:" & ConvertToLetter(k) & myR & ","""")))" next i End Sub このtest2は、きちんと実行され、目的とするG4(~AE4)のセルに =IF(G3="","",SUM(G5:G30)/(30-COUNTIF(G5:G30,""))) という式が挿入されました。 質問1:なぜ、test1がダメで、test2ならうまくいくのかという理由がわかりません。 質問2:うまくいったtest2と同じ式を、もっと長いプログラムの中に入れるとやはり「ByRef引数の型が一致しません」エラーが出てプログラムが止まってしまいます。test2単独のプログラムならうまく動くのに、他のプログラムの一部に埋め込むとエラーが出る理由もわかりません。 VBAプログラムを試行錯誤しながら勉強している初心者です。どなたかご教示お願いします。 ちなみに、ConvertToLetterは、 Function ConvertToLetter(iCol As Integer) As String Dim iAlpha As Integer Dim iRemainder As Integer iAlpha = Int((iCol - 1) / 26) iRemainder = iCol - (iAlpha * 26) If iAlpha > 0 Then ConvertToLetter = Chr(iAlpha + 64) End If If iRemainder > 0 Then ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) End If End Function という、関数で定義しています。

  • 型が一致しません

    下記はセルが0の時、行全体を表示しないにするようにするVBAですが、型が一致しませんとエラーになります、どこを直せばいいのですか。 Dim I As Integer Sub Macro4() For I = 4 To 76 If Cells(I, 8) = 0 Then Rows("I:I").Select Selection.EntireRow.Hidden = True End If Next I End Sub

  • String だと「 ByRef引数の型が一致しません 」というエラーが出ます。なぜ?

    ここで「Kaplan-Meyer 生存分析に便利なソフトを教えて」と質問した shuu_01 です。ここで VisualBasic のソースのありかを教えて頂き、自分に使いやすいようソースを書き換えようと奮闘中です(それまで VisualBasic の経験がなく 無謀!と実感中です)。 元々のソースはグラフが1本だけだったので、肺癌だと「腺癌」「扁平上皮癌」「小細胞癌」、、といろんな癌の種類別にグラフを数本 書くのが目標です。そこで、 Sub km_test() Dim nc As Integer, gr() As String nc = 2 ReDim gr(nc) gr(0) = "腺癌" gr(1) = "扁平上皮癌" gr(2) = "小細胞癌" km_group_test nc, gr End Sub Sub km_group_test(nc As Integer, gr As String) End Sub というソースを書くと: String の変数 gr の色が変わり、「 ByRef引数の型が一致しません 」というエラーが出ます。 Integer の変数 nc ではエラーが出ません。 きちんと型を一致させているつもりなのに、なぜ???

  • 型が一致しません

    特定のセルでダブルクリックすると「〇」が入り,再度ダブルクリックすると「〇」が消えるコードを調べ,以下のものです。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const rng As String = "A1:B3" '処理対象のセル範囲 If Not Application.Intersect(Target, Range(rng)) Is Nothing Then If Target.Value = "" Then Target.Value = "○" Else Target.ClearContents End If End If End Sub 試してみましたが,「実行時エラー13 型が一致しません」というものが出て,デバックというところをクリックすると,If Target.Value = "" Thenのところが黄色くなり矢印が出ていたのでここが問題かなと思うのですが,どのように修正すればいいのか分かりません。教えていただけると助かります。

  • 型が一致しません

    いつもお世話になっております。 シートごとに元データの値でフィルタをかけ、 フィルタした各シートのD列の文字列を照らし合わせて整合性を確認したく、 下記のようなVBAをつくりましたが、ここで↓ If name_A <> name_B <> name_C <> name_D Then 型が一致しませんとエラーになります。 どなたかアドバイスをお願いいたします。 Sub 不整合チェック()  'フィルター  Worksheets("Aリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Bリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Cリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Dリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3") '整合性チェック  Dim name_A As String  Dim name_B As String  Dim name_C As String  Dim name_D As String  name_A = Worksheets("Aリスト").Cells(65536, 4).End(xlUp).Value  name_B = Worksheets("Bリスト").Cells(65536, 4).End(xlUp).Value  name_C = Worksheets("Cリスト").Cells(65536, 4).End(xlUp).Value  name_D = Worksheets("Dリスト").Cells(65536, 4).End(xlUp).Value  If name_A <> name_B <> name_C <> name_D Then   MsgBox "データ不整合を発見しました。 処理を中断します。", vbCritical   Exit Sub  ElseIf mykouiji_kouji = name_nyukin = name_kokyaku = name_uriage Then   MsgBox "問題なし。"  End If End Sub

  • 「:」を使えば、一行のコードにできるわけではない?

    「:」を使えば、一行のコードにできるわけではないのですか? ifステートメントを1行にしたいのですが Sub test() Dim a As String a = "aiu" If a Like "*i*" Then: Stop: End If End Sub これだと End If に対応する If ブロックがありません。 となってしまいます。 ちゃんと、 Sub test() Dim a As String a = "aiu" If a Like "*i*" Then Stop End If End Sub こうしないとダメですか? なぜ、:は使えないのですか? よろしくお願いします。

  • ▲ExcelのVBA▼困っています

    何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…?; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

  • Access2010 「型が一致しません。」エラー

    お世話になっております。 テキストファイルからデータを取り込んで、テーブルにあるデータと同じデータのみを表示させるプログラムがあります。 コードが「001」のように整数の場合は問題ないのですが、「A001」のように英数のデータの場合は、このエラーが出てしまいます。 「実行時エラー13 型が一致しません。」 デバッグをクリックすると、下記の部分が黄色に反転します。 「If DFirst("コード", "テーブル", "コード = '" & avarFldData(0) & "'") Then」 テキストファイルのデータがテーブルにない場合はエラーが出ませんので、一致したデータがある場合のみエラーが出ます。 VBAはあまり詳しくありませんので、エラーが出なくなる方法を教えていただければ助かります。 よろしくお願いいたします。 Private Sub Form_Load() Dim dbs As Database Dim rst As Recordset Dim strImportDir As String Dim strFile As String Dim lngFileNum As Long Dim strData As String Dim avarFldData As Variant Dim iintLoop As Integer DoCmd.Hourglass True strImportDir = Application.CurrentProject.Path & "\" strFile = strImportDir & "File.TXT" Set dbs = CurrentDb GoSub ReadFile Me.Requery DoCmd.Hourglass False Exit Sub ReadFile: Set rst = dbs.OpenRecordset("履歴", dbOpenDynaset, dbAppendOnly) lngFileNum = FreeFile() Open strFile For Input As #lngFileNum Do Until EOF(lngFileNum) Line Input #lngFileNum, strData avarFldData = Split(strData, ",", , vbTextCompare) For iintLoop = 0 To UBound(avarFldData) avarFldData(iintLoop) = Trim$(avarFldData(iintLoop)) Next iintLoop If DFirst("コード", "テーブル", "コード = '" & avarFldData(0) & "'") Then With rst .AddNew !コード = avarFldData(0) .Update End With End If ' End If Loop Close #lngFileNum rst.Close Kill strFile Return End Sub

  • 下記のマクロをもっと早くするには?

    下記のマクロは、 A列にあるURLがSSL化(https)されているかを調べるものです。 このマクロを動かすと、大体3秒に1つの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

このQ&Aのポイント
  • DCP-J978Nのインクが検知できないエラーが発生しました。暑い日が続いたことが原因かもしれません。新しいインクに交換してもエラーは解消されず、カートリッジを抜き差ししても改善しません。
  • 接続環境は無線LANで、OSはWindows11です。関連するソフトやアプリは特にありません。電話回線はひかり回線を使用しています。
  • DCP-J978Nのインクが検知されない問題が発生しました。暑さによる影響かもしれませんが、新しいインクカートリッジへの交換や再度の差し込みなど試しても改善しません。接続環境は無線LANで、OSはWindows11です。関連するソフトやアプリはありません。電話回線はひかり回線です。
回答を見る